module DDC.Build.Interface.Base
( Interface (..)
, makeInterfaceTearLine
, takeInterfaceTearLine
, isInterfaceTearLine)
where
import DDC.Core.Module
import DDC.Core.Pretty
import DDC.Core.Exp.Annot
import Data.Maybe
import Data.Time.Clock
import qualified Data.Char as Char
import qualified DDC.Core.Tetra as Tetra
import qualified DDC.Core.Salt as Salt
data Interface ta sa
= Interface
{
interfaceFilePath :: FilePath
, interfaceTimeStamp :: UTCTime
, interfaceVersion :: String
, interfaceModuleName :: ModuleName
, interfaceTetraModule :: Maybe (Module ta Tetra.Name)
, interfaceSaltModule :: Maybe (Module sa Salt.Name) }
instance Pretty (Interface ta sa) where
ppr i
= (text "ddc interface" <+> text (interfaceVersion i))
<> line <> line
<> vcat [ text $ makeInterfaceTearLine "Meta"
, text "module-meta" <+> lbrace <> line
<> indent 8 (vcat
[ hsep [text "name:", ppr $ interfaceModuleName i ] ])
<> line <> rbrace]
<> (case interfaceTetraModule i of
Just m -> vcat [ line
, text $ makeInterfaceTearLine "Tetra"
, ppr m ]
Nothing -> empty)
<> (case interfaceSaltModule i of
Just m ->
let m' = m { moduleBody = xUnit (annotOfExp $ moduleBody m) }
in vcat [ line
, text $ makeInterfaceTearLine "Salt"
, ppr m' ]
Nothing -> empty)
makeInterfaceTearLine :: String -> String
makeInterfaceTearLine name
= "~~ " ++ name ++ " " ++ replicate (80 4 length name) '~'
takeInterfaceTearLine :: String -> Maybe String
takeInterfaceTearLine str
| '~' : '~' : ' ' : str2 <- str
, (name, str3) <- span (not . Char.isSpace) str2
, (' ' : rest) <- str3
, all (== '~') rest
= Just name
| otherwise
= Nothing
isInterfaceTearLine :: String -> Bool
isInterfaceTearLine str
= isJust $ takeInterfaceTearLine str