{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TupleSections     #-}
module Apigen.Language.Haskell where

import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.Maybe                  (catMaybes)
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), LexemeClass (..),
                                              Node, NodeF (..))
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import qualified Text.Casing                 as Casing


joinLines :: [Text] -> Text
joinLines :: [Text] -> Text
joinLines = Text -> [Text] -> Text
Text.intercalate Text
"\n"


idToHaskell :: Text -> Text
idToHaskell :: Text -> Text
idToHaskell =
    String -> Text
Text.pack
    (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> String
Casing.toPascal
    (Identifier String -> String)
-> (Text -> Identifier String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Identifier String
forall a. [a] -> Identifier a
Casing.Identifier
    ([String] -> Identifier String)
-> (Text -> [String]) -> Text -> Identifier String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
dropNamespace
    ([String] -> [String]) -> (Text -> [String]) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> [String]
forall a. Identifier a -> [a]
Casing.unIdentifier
    (Identifier String -> [String])
-> (Text -> Identifier String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
Casing.fromSnake
    (String -> Identifier String)
-> (Text -> String) -> Text -> Identifier String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
  where
    -- Drop the first component of the name, but only if there are at least
    -- 2 components.
    dropNamespace :: [a] -> [a]
dropNamespace (a
_:name :: [a]
name@(a
_:[a]
_)) = [a]
name
    dropNamespace [a]
name           = [a]
name


maybeParen :: Text -> Text
maybeParen :: Text -> Text
maybeParen Text
name
    | Char
' ' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> String
Text.unpack Text
name = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    | Bool
otherwise                   = Text
name


isErrorEnum :: Text -> Bool
isErrorEnum :: Text -> Bool
isErrorEnum Text
tyName =
    case Identifier String -> [String]
forall a. Identifier a -> [a]
Casing.unIdentifier (Identifier String -> [String])
-> (Text -> Identifier String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
Casing.fromSnake (String -> Identifier String)
-> (Text -> String) -> Text -> Identifier String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> [String]) -> Text -> [String]
forall a b. (a -> b) -> a -> b
$ Text
tyName of
        (String
_:String
"Err":[String]
_) -> Bool
True
        [String]
_           -> Bool
False


genStdType :: Text -> Text
genStdType :: Text -> Text
genStdType Text
"uint16_t" = Text
"Word16"
genStdType Text
"uint32_t" = Text
"Word32"
genStdType Text
"uint64_t" = Text
"Word64"
genStdType Text
"size_t"   = Text
"CSize"
genStdType Text
"bool"     = Text
"Bool"
genStdType Text
tyName     = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
tyName


genType :: Node (Lexeme Text) -> Text
genType :: Node (Lexeme Text) -> Text
genType                               (Fix (TyUserDefined (L AlexPosn
_ LexemeClass
IdSueType Text
tyName))) =
    Text
"CEnum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
idToHaskell Text
tyName
genType (Fix (TyPointer               (Fix (TyUserDefined (L AlexPosn
_ LexemeClass
IdSueType Text
tyName)))  ))
    | Text -> Bool
isErrorEnum Text
tyName = Text
"CErr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
idToHaskell Text
tyName
    | Bool
otherwise = Text -> Text
idToHaskell Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ptr"

genType (Fix (TyPointer (Fix (TyConst (Fix (TyUserDefined (L AlexPosn
_ LexemeClass
IdSueType Text
tyName))))))) =
    Text -> Text
idToHaskell Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ptr"
genType (Fix (TyPointer (Fix (TyConst (Fix (TyStruct (L AlexPosn
_ LexemeClass
IdSueType Text
tyName))))))) =
    Text -> Text
idToHaskell Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ptr"
genType (Fix (TyPointer               (Fix (TyStruct (L AlexPosn
_ LexemeClass
IdSueType Text
tyName)))  )) =
    Text -> Text
idToHaskell Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ptr"

genType (Fix (TyPointer               (Fix (TyStd (L AlexPosn
_ LexemeClass
IdStdType Text
"uint8_t")))  )) =
    Text
"CString"
genType (Fix (TyPointer (Fix (TyConst (Fix (TyStd (L AlexPosn
_ LexemeClass
IdStdType Text
"uint8_t"))))))) =
    Text
"CString"
genType (Fix (TyPointer (Fix (TyConst (Fix (TyStd (L AlexPosn
_ LexemeClass
IdStdType Text
"char"))))))) =
    Text
"CString"

genType (Fix (TyPointer (Fix (TyStd (L AlexPosn
_ LexemeClass
KwVoid Text
_))))) =
    Text
"Ptr ()"
genType (Fix (TyPointer (Fix (TyFunc (L AlexPosn
_ LexemeClass
IdFuncType Text
tyName))))) =
    Text
"FunPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
idToHaskell Text
tyName
genType                 (Fix (TyStd (L AlexPosn
_ LexemeClass
IdStdType Text
tyName))) =
    Text -> Text
genStdType Text
tyName
genType (Fix (TyPointer (Fix (TyStd (L AlexPosn
_ LexemeClass
IdStdType Text
tyName))))) =
    Text
"Ptr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
genStdType Text
tyName
genType (Fix (TyStd (L AlexPosn
_ LexemeClass
KwVoid Text
_))) =
    Text
"()"
genType Node (Lexeme Text)
ty = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> String
forall a. Show a => a -> String
show Node (Lexeme Text)
ty


genArg :: Node (Lexeme Text) -> Text
genArg :: Node (Lexeme Text) -> Text
genArg (Fix (VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_)) = Node (Lexeme Text) -> Text
genType Node (Lexeme Text)
ty
genArg Node (Lexeme Text)
arg                    = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> String
forall a. Show a => a -> String
show Node (Lexeme Text)
arg


genArgs :: [Node (Lexeme Text)] -> Text
genArgs :: [Node (Lexeme Text)] -> Text
genArgs [Node (Lexeme Text)]
args = Text -> [Text] -> Text
Text.intercalate Text
" -> " ((Node (Lexeme Text) -> Text) -> [Node (Lexeme Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> Text
genArg [Node (Lexeme Text)]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> "


genFunction :: Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFunction :: Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFunction Node (Lexeme Text)
retTy Text
name [(Fix (TyStd (L AlexPosn
_ LexemeClass
KwVoid Text
_)))] =
    Text
"foreign import ccall " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme Text) -> Text
genType Node (Lexeme Text)
retTy
genFunction Node (Lexeme Text)
retTy Text
name [Node (Lexeme Text)]
args =
    Text
"foreign import ccall " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Node (Lexeme Text)] -> Text
genArgs [Node (Lexeme Text)]
args Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"IO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
maybeParen (Node (Lexeme Text) -> Text
genType Node (Lexeme Text)
retTy)


genFuncType :: Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFuncType :: Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFuncType Node (Lexeme Text)
retTy Text
name [Node (Lexeme Text)]
args = [Text] -> Text
joinLines
    [ Text
"type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Node (Lexeme Text)] -> Text
genArgs [Node (Lexeme Text)]
args Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"IO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
maybeParen (Node (Lexeme Text) -> Text
genType Node (Lexeme Text)
retTy)
    , Text
"foreign import ccall \"wrapper\" wrap" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> IO (FunPtr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    ]
  where
    hsName :: Text
hsName = Text -> Text
idToHaskell Text
name


genEnumerator :: Bool -> Node (Lexeme Text) -> Maybe Text
genEnumerator :: Bool -> Node (Lexeme Text) -> Maybe Text
genEnumerator Bool
isErr (Fix (Enumerator (L AlexPosn
_ LexemeClass
_ Text
name) Maybe (Node (Lexeme Text))
_))
    -- Skip the OK error, because we process that in CErr handling.
    | Bool
isErr Bool -> Bool -> Bool
&& Text
"_OK" Text -> Text -> Bool
`Text.isSuffixOf` Text
name = Maybe Text
forall a. Maybe a
Nothing
    | Bool
otherwise                             = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
idToHaskell Text
name
genEnumerator Bool
_ (Fix Comment{}) = Maybe Text
forall a. Maybe a
Nothing
genEnumerator Bool
_ Node (Lexeme Text)
x = String -> Maybe Text
forall a. HasCallStack => String -> a
error (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> String
forall a. Show a => a -> String
show Node (Lexeme Text)
x


genEnum :: Text -> [Node (Lexeme Text)] -> Text
genEnum :: Text -> [Node (Lexeme Text)] -> Text
genEnum Text
name [Node (Lexeme Text)]
enums = [Text] -> Text
joinLines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName
    , Text
"    = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"\n    | " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ((Node (Lexeme Text) -> Maybe Text)
-> [Node (Lexeme Text)] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Node (Lexeme Text) -> Maybe Text
genEnumerator (Text -> Bool
isErrorEnum Text
name)) [Node (Lexeme Text)]
enums))
    , Text
"    deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)"
    , Text
"instance MessagePack " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName
    , Text
"instance Arbitrary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where arbitrary = arbitraryBoundedEnum"
    ]
  where
    hsName :: Text
hsName = Text -> Text
idToHaskell Text
name


genStruct :: Text -> Text
genStruct :: Text -> Text
genStruct Text
name = [Text] -> Text
joinLines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
structName
    , Text
"type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ptrName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = Ptr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
structName
    ]
  where
    structName :: Text
structName = Text -> Text
idToHaskell Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Struct"
    ptrName :: Text
ptrName    = Text -> Text
idToHaskell Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ptr"


generator :: AstActions (State [Text]) Text
generator :: AstActions (State [Text]) Text
generator = AstActions (State [Text]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String -> Node (Lexeme Text) -> State [Text] () -> State [Text] ()
doNode = \String
_file Node (Lexeme Text)
node State [Text] ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDecl Scope
_ (Fix (FunctionPrototype Node (Lexeme Text)
retTy (L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
args)) ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFunction Node (Lexeme Text)
retTy Text
name [Node (Lexeme Text)]
argsText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
            Struct (L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_ ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> Text
genStruct Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
            Typedef Node (Lexeme Text)
_ (L AlexPosn
_ LexemeClass
_ Text
name) ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> Text
genStruct Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
            TypedefFunction (Fix (FunctionPrototype Node (Lexeme Text)
retTy (L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
args)) ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Node (Lexeme Text) -> Text -> [Node (Lexeme Text)] -> Text
genFuncType Node (Lexeme Text)
retTy Text
name [Node (Lexeme Text)]
argsText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
            EnumDecl (L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
enums Lexeme Text
_ ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> [Node (Lexeme Text)] -> Text
genEnum Text
name [Node (Lexeme Text)]
enumsText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
            EnumConsts (Just (L AlexPosn
_ LexemeClass
_ Text
name)) [Node (Lexeme Text)]
enums ->
                ([Text] -> [Text]) -> State [Text] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> [Node (Lexeme Text)] -> Text
genEnum Text
name [Node (Lexeme Text)]
enumsText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)

            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State [Text] ()
act
    }


addPrologue :: FilePath -> [Text] -> [Text]
addPrologue :: String -> [Text] -> [Text]
addPrologue String
file = (
    [ Text
"{-# LANGUAGE DeriveGeneric #-}"
    , Text
"{-# OPTIONS_GHC -Wno-unused-imports #-}"
    , Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
hsModuleName String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where"
    , Text
""
    , Text
"import           Data.MessagePack          (MessagePack)"
    , Text
"import           Data.Word                 (Word16, Word32, Word64)"
    , Text
"import           Foreign.C.Enum            (CEnum (..), CErr)"
    , Text
"import           Foreign.C.String          (CString)"
    , Text
"import           Foreign.C.Types           (CInt (..), CSize (..))"
    , Text
"import           Foreign.Ptr               (FunPtr, Ptr)"
    , Text
"import           GHC.Generics              (Generic)"
    , Text
"import           Test.QuickCheck.Arbitrary (Arbitrary (..),"
    , Text
"                                            arbitraryBoundedEnum)"
    , if Text
"tox/tox_events.h" Text -> Text -> Bool
`Text.isSuffixOf` String -> Text
Text.pack String
file then Text
"import FFI.Tox.Tox" else Text
""
    ][Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
  where
    hsModuleName :: String -> Text
hsModuleName =
        (Text
"FFI."Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"."
        ([Text] -> Text) -> (String -> [Text]) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> String
Casing.toPascal (Identifier String -> String)
-> (Text -> Identifier String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Identifier String
forall a. [a] -> Identifier a
Casing.Identifier ([String] -> Identifier String)
-> (Text -> [String]) -> Text -> Identifier String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
        ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
2 ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse  -- takeEnd from extra
        ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"/"
        (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.dropEnd Int
2
        (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack


generate :: (FilePath, [Node (Lexeme Text)]) -> (FilePath, Text)
generate :: (String, [Node (Lexeme Text)]) -> (String, Text)
generate input :: (String, [Node (Lexeme Text)])
input@(String
file, [Node (Lexeme Text)]
_) = (String, [Node (Lexeme Text)]) -> (String, Text)
go (String, [Node (Lexeme Text)])
input
  where
    go :: (String, [Node (Lexeme Text)]) -> (String, Text)
go = (String
file,) (Text -> (String, Text))
-> ((String, [Node (Lexeme Text)]) -> Text)
-> (String, [Node (Lexeme Text)])
-> (String, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
joinLines ([Text] -> Text)
-> ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Text] -> [Text]
addPrologue String
file ([Text] -> [Text])
-> ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Text] () -> [Text] -> [Text])
-> [Text] -> State [Text] () -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Text] () -> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (State [Text] () -> [Text])
-> ((String, [Node (Lexeme Text)]) -> State [Text] ())
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Text]) Text
-> (String, [Node (Lexeme Text)]) -> State [Text] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Text]) Text
generator