@@ -49,6 +49,7 @@ import Data.Function (fix)
49
49
import qualified Data.IntMap as IntMap
50
50
import Data.List (sortOn )
51
51
import Data.List.NonEmpty (NonEmpty , fromList )
52
+ import Data.Maybe (listToMaybe )
52
53
import Data.Monoid (First (.. ))
53
54
import qualified Data.Set as Set
54
55
import Data.String (IsString (.. ))
@@ -117,8 +118,7 @@ eval eval = \case
117
118
u' <- eval u
118
119
t' >>> u'
119
120
Import ns -> S. simport ns >> dunit
120
- Function n ps b -> letrec n (dabs ps (\ as ->
121
- foldr (\ (p, a) m -> let' p a m) (eval b) (zip ps as)))
121
+ Function n ps b -> letrec n (dabs ps (foldr (\ (p, a) m -> let' p a m) (eval b) . zip ps))
122
122
Call f as -> do
123
123
f' <- eval f
124
124
as' <- traverse eval as
@@ -153,7 +153,7 @@ parseFile srcPath jsonPath = do
153
153
let sourcePath = replaceExtensions jsonPath " py"
154
154
sourceContents <- Source. fromUTF8 . B. toStrict <$> liftIO (B. readFile srcPath)
155
155
let span = decrSpan (Source. totalSpan sourceContents)
156
- case ( A. eitherDecodeWith A. json' (A. iparse parseGraph) contents) of
156
+ case A. eitherDecodeWith A. json' (A. iparse parseGraph) contents of
157
157
Left (_, err) -> throwError err
158
158
Right (_, Nothing ) -> throwError " no root node found"
159
159
Right (_, Just root) -> pure (sourceContents, File (Reference sourcePath span ) root)
@@ -189,7 +189,7 @@ parseTerm attrs edges = locate attrs . \case
189
189
" string" -> const . String <$> attrs A. .: fromString " text"
190
190
" true" -> pure (const (Bool True ))
191
191
" false" -> pure (const (Bool False ))
192
- " throw" -> fmap Throw <$> resolve (head edges)
192
+ " throw" -> fmap Throw <$> maybe empty resolve (listToMaybe edges)
193
193
" if" -> liftA3 Iff <$> findEdgeNamed edges " condition" <*> findEdgeNamed edges " consequence" <*> findEdgeNamed edges " alternative" <|> pure (const Noop )
194
194
" block" -> children edges
195
195
" module" -> children edges
@@ -205,7 +205,7 @@ findEdgeNamed edges name = foldMap (resolveWith (\ rep attrs -> attrs A..: fromS
205
205
206
206
-- | Map a list of edges to a list of child nodes.
207
207
children :: [A. Value ] -> A. Parser (Graph -> Term )
208
- children edges = fmap chain . sequenceA . map snd . sortOn fst <$> traverse (resolveWith child) edges
208
+ children edges = fmap chain . traverse snd . sortOn fst <$> traverse (resolveWith child) edges
209
209
where
210
210
child :: (Graph -> Term ) -> A. Object -> A. Parser (Int , Graph -> Term )
211
211
child term attrs = (,) <$> attrs A. .: fromString " index" <*> pure term
0 commit comments