Add ast internal util

1 files changed, 89 insertions, 0 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/Util.hs b/src/Language/Fiddle/Ast/Internal/Util.hs
new file mode 100644
index 0000000..2a03227
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Util.hs
@@ -0,0 +1,89 @@
+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.SyntaxTree
+import Language.Fiddle.Internal.UnitInterface
+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) ->
+  NonEmpty 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 ::
+  (Integral i, Integral (NumberType stage)) =>
+  Expression stage f a ->
+  Either String i
+expressionToInt = \case
+  LitNum {litNumValue = v} -> return (fromIntegral v)
+  _ -> Left "Incorrect Expression"