ngws/mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Expose fewer modules

Browse Source
This commit is contained in:
Niels G. W. Serup
2024-11-09 22:55:42 +01:00
parent a60f652242
commit 67fb3f8871
4 changed files with 81 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
byg/src/Byg/DependencyFormatter.hs Normal file
View File

@@ -0,0 +1,73 @@
{-# LANGUAGE MonoLocalBinds #-}
module Byg.DependencyFormatter
( formatDependencyTrees
) where
import Byg.Types.Token (Token(..))
import Byg.Types.Dependency (Dependency(..), Action(..))
import Type.Reflection (TypeRep, typeRep)
import Text.Printf (printf)
import Data.Text (Text)
import qualified Data.Text as T
formatDependencyTrees :: [Dependency] -> Text
formatDependencyTrees = T.concat . (formatDependencyTrees' "")
where formatDependencyTrees' indentation = concatMap (formatDependencyTree indentation)
formatDependencyTree indentation (Dependency _ a action _ b) =
concat [ [ indentation ]
, formatToken a
, [ " -> " ]
, formatToken b
, [ ": " ]
, formatAction indentation action
]
formatToken :: Token a -> [Text]
formatToken = \case
Token i ->
[ T.pack (printf "%03d" i) ]
TupleToken a b ->
concat [ [ "tup(" ]
, formatToken a
, [ ", " ]
, formatToken b
, [ ")" ]
]
ZipToken a b ->
concat [ [ "zip(" ]
, formatToken a
, [ ", " ]
, formatToken b
, [ ")" ]
]
ListToken ts ->
[ "["
, T.intercalate ", " (map (T.concat . formatToken) ts)
, "]"
]
NoToken ->
[ "--" ]
formatAction :: forall a b. Text -> Action a b -> [Text]
formatAction indentation = \case
Function _ ->
[ "Function "
, T.pack (show (typeRep :: TypeRep a))
, " -> "
, T.pack (show (typeRep :: TypeRep b))
, "\n"
]
MapComp subDeps innerInput innerOutput ->
concat [ [ "MapComp(" ]
, formatToken innerInput
, [ " -> " ]
, formatToken innerOutput
, [ "):\n" ]
, formatDependencyTrees' (T.append indentation "| ") subDeps
]
action ->
[ T.pack (show action)
, "\n"
]

65
byg/src/Byg/Types/Dependency.hs
View File

@@ -9,16 +9,12 @@ module Byg.Types.Dependency
, actionReads
, actionWrites
, actionWritesAny
, formatDependencyTrees
) where
import Byg.Types.Token (Token(..))
import Byg.Types.Functions (IsFunctionIO(..))
import Type.Reflection (Typeable, TypeRep, typeRep)
import Text.Printf (printf)
import Data.Text (Text)
import qualified Data.Text as T
data Action a b where
Function :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
@@ -68,64 +64,3 @@ actionWritesAny = \case
_ -> False
where dependencyWritesAny :: Dependency -> Bool
dependencyWritesAny (Dependency _ _ action _ _) = actionWritesAny action
formatDependencyTrees :: [Dependency] -> Text
formatDependencyTrees = T.concat . (formatDependencyTrees' "")
where formatDependencyTrees' indentation = concatMap (formatDependencyTree indentation)
formatDependencyTree indentation (Dependency _ a action _ b) =
concat [ [ indentation ]
, formatToken a
, [ " -> " ]
, formatToken b
, [ ": " ]
, formatAction indentation action
]
formatToken :: Token a -> [Text]
formatToken = \case
Token i ->
[ T.pack (printf "%03d" i) ]
TupleToken a b ->
concat [ [ "tup(" ]
, formatToken a
, [ ", " ]
, formatToken b
, [ ")" ]
]
ZipToken a b ->
concat [ [ "zip(" ]
, formatToken a
, [ ", " ]
, formatToken b
, [ ")" ]
]
ListToken ts ->
[ "["
, T.intercalate ", " (map (T.concat . formatToken) ts)
, "]"
]
NoToken ->
[ "--" ]
formatAction :: forall a b. Text -> Action a b -> [Text]
formatAction indentation = \case
Function _ ->
[ "Function "
, T.pack (show (typeRep :: TypeRep a))
, " -> "
, T.pack (show (typeRep :: TypeRep b))
, "\n"
]
MapComp subDeps innerInput innerOutput ->
concat [ [ "MapComp(" ]
, formatToken innerInput
, [ " -> " ]
, formatToken innerOutput
, [ "):\n" ]
, formatDependencyTrees' (T.append indentation "| ") subDeps
]
action ->
[ T.pack (show action)
, "\n"
]