From 67fb3f8871efcefed419dbf160f14faf6c393316 Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Sat, 9 Nov 2024 22:55:42 +0100 Subject: [PATCH] Expose fewer modules --- byg/app/Main.hs | 4 +- byg/byg.cabal | 10 ++-- byg/src/Byg/DependencyFormatter.hs | 73 ++++++++++++++++++++++++++++++ byg/src/Byg/Types/Dependency.hs | 65 -------------------------- 4 files changed, 81 insertions(+), 71 deletions(-) create mode 100644 byg/src/Byg/DependencyFormatter.hs diff --git a/byg/app/Main.hs b/byg/app/Main.hs index 34cc764..3497bbe 100644 --- a/byg/app/Main.hs +++ b/byg/app/Main.hs @@ -2,7 +2,7 @@ module Main where import Byg.Types (Dependency) import qualified Byg.DependencyRunner as DR -import qualified Byg.Types.Dependency as D +import qualified Byg.DependencyFormatter as DF import Byg.DependencyGenerator (evalDepGenM) import SiteGenerator (generateSite) @@ -21,6 +21,6 @@ main = do ((), filesWritten) <- DR.runDepRunMIO $ DR.runDeps dependencies putStrLn ("Files which could have been written: " ++ show filesWritten) ["tree"] -> - T.putStr $ D.formatDependencyTrees dependencies + T.putStr $ DF.formatDependencyTrees dependencies _ -> error "unexpected arguments" diff --git a/byg/byg.cabal b/byg/byg.cabal index 781d06d..8a2b28c 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -20,13 +20,17 @@ library import: common hs-source-dirs: src exposed-modules: + Byg.Types + Byg.DependencyGenerator + Byg.Functions + Byg.DependencyFormatter + Byg.DependencyRunner + other-modules: Byg.Types.Token Byg.Types.Value Byg.Types.Functions Byg.Types.Dependency Byg.Types.Date - Byg.Types - Byg.DependencyGenerator Byg.Functions.Image Byg.Functions.Pandoc Byg.Functions.Paths @@ -34,8 +38,6 @@ library Byg.Functions.Text Byg.Functions.Date Byg.Functions.Atom - Byg.Functions - Byg.DependencyRunner build-depends: base >=4.14 && <4.20 , mtl diff --git a/byg/src/Byg/DependencyFormatter.hs b/byg/src/Byg/DependencyFormatter.hs new file mode 100644 index 0000000..742a709 --- /dev/null +++ b/byg/src/Byg/DependencyFormatter.hs @@ -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" + ] diff --git a/byg/src/Byg/Types/Dependency.hs b/byg/src/Byg/Types/Dependency.hs index 59f59d1..bafe0cb 100644 --- a/byg/src/Byg/Types/Dependency.hs +++ b/byg/src/Byg/Types/Dependency.hs @@ -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" - ]