blob: d2be0c31d625ce596d43904fb46eee45b58f990a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
module Language.Fiddle.Ast.Internal.Util where
import Data.Functor.Identity
import Data.List.NonEmpty hiding (map)
import qualified Data.Text as Text
import Language.Fiddle.Ast.Internal.Instances
import Language.Fiddle.Ast.Internal.MetaTypes
import Language.Fiddle.Ast.Internal.Stage
import Language.Fiddle.Ast.Internal.SyntaxTree
import Language.Fiddle.Internal.UnitInterface
import Language.Fiddle.Internal.UnitNumbers
import Language.Fiddle.Types
-- | 'squeeze' traverses a structure ('t') with a monadic functor ('f')
-- and transforms it into a structure using the 'Identity' functor. It
-- does this by using the 'alter' function to change the functor used
-- in the structure, applying 'Identity' to the elements.
--
-- This is useful when you want to convert a data structure with
-- a complex functor ('f') into one that uses 'Identity', effectively
-- "squeezing" out the monadic effects.
squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a)
squeeze = alter (fmap Identity) return
-- | 'soak' takes a function that wraps a value in an arbitrary functor
-- ('f') and applies it to a structure ('t') that currently uses the
-- 'Identity' functor, transforming the structure to use the new functor.
-- It uses 'alter' to traverse and replace the 'Identity' functor in the
-- structure with the specified functor ('f').
--
-- This allows "soaking" a structure that was using 'Identity' into
-- another functor ('f') by applying the given function to each element.
soak :: (Alter t) => (forall x. x -> f x) -> t Identity a -> t f a
soak fn t = runIdentity $ alter (return . fn . runIdentity) return t
-- | 'soakA' is a specialized version of 'soak' that uses the 'pure'
-- function to apply an 'Applicative' functor ('f') to each element
-- of a structure ('t') that is currently using the 'Identity' functor.
--
-- This "soaks" the structure into the specified applicative functor,
-- transforming all the 'Identity' elements into instances of the
-- given 'Applicative'.
soakA :: (Applicative f, Alter t) => t Identity a -> t f a
soakA = soak pure
nameToList :: Name f a -> NonEmpty String
nameToList (Name ids _) = fmap (Text.unpack . identifierName) ids
identToString :: Identifier f a -> String
identToString = Text.unpack . identifierName
directiveToMetadata ::
(Annotated (t s)) =>
Directed t s Identity (Commented SourceSpan) ->
QualifiedPath String ->
Metadata
directiveToMetadata (Directed directives t a) qualifiedPath =
Metadata
{ metadataSourceSpan = unCommented a,
metadataDocComment = docComments (annot t),
metadataDirectives = concatMap toExportedDirective directives,
metadataFullyQualifiedPath = qualifiedPath
}
where
toExportedDirective (Directive (Identity (DirectiveBody elements _)) _) =
map
( \case
(DirectiveElementKey backend key _) ->
InternalDirective
(identToString <$> backend)
(identToString key)
Nothing
(DirectiveElementKeyValue backend key expr _) ->
InternalDirective
(identToString <$> backend)
(identToString key)
( Just $ case expr of
(DirectiveString v _) ->
InternalDirectiveExpressionString (Text.unpack v)
(DirectiveNumber v _) ->
InternalDirectiveExpressionNumber (Text.unpack v)
)
)
elements
expressionToInt ::
(stage .< Expanded ~ False) =>
Expression u stage f a ->
Either String (N u)
expressionToInt = \case
LitNum {litNumValue = (RightV v)} -> return (fromIntegral v)
_ -> Left "Incorrect Expression"
|
