Clean up and move things around
This commit is contained in:
parent
a098317df3
commit
e7e767c007
|
@ -17,14 +17,17 @@ library
|
||||||
import: common
|
import: common
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
|
Types.Token
|
||||||
|
Types.Values
|
||||||
|
Types.Value
|
||||||
|
Types.Function
|
||||||
|
Types.FunctionIO
|
||||||
Types
|
Types
|
||||||
Sources
|
|
||||||
FunctionImplementations.Pure
|
|
||||||
FunctionImplementations.IO
|
|
||||||
Dependency
|
Dependency
|
||||||
ComputationM
|
DependencyGenerator
|
||||||
Functions
|
Evaluation.Function
|
||||||
Generator
|
Evaluation.FunctionIO
|
||||||
|
SiteGenerator
|
||||||
build-depends:
|
build-depends:
|
||||||
base
|
base
|
||||||
, mtl
|
, mtl
|
||||||
|
|
|
@ -1,95 +0,0 @@
|
||||||
module ComputationM
|
|
||||||
( ComputationM
|
|
||||||
, evalComputationM
|
|
||||||
, inject
|
|
||||||
-- , inject'
|
|
||||||
, mapComputationM
|
|
||||||
, mapComputationM_
|
|
||||||
, filterComputationM
|
|
||||||
, runFunction
|
|
||||||
, runFunctionIO
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Dependency
|
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import Control.Monad.Writer
|
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
|
|
||||||
newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUntyped] (State Int) a }
|
|
||||||
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [DependencyUntyped])
|
|
||||||
|
|
||||||
type ComputationM a = ComputationM' (Token a)
|
|
||||||
|
|
||||||
evalComputationM' :: Int -> ComputationM () -> ([DependencyUntyped], Int)
|
|
||||||
evalComputationM' top m = runState (execWriterT (unComputationM m)) top
|
|
||||||
|
|
||||||
evalComputationM :: ComputationM () -> [DependencyUntyped]
|
|
||||||
evalComputationM m = fst (evalComputationM' 0 m)
|
|
||||||
|
|
||||||
tellDep :: (Show a, Show b, Lift a, Lift b) => Dependency a b -> ComputationM' ()
|
|
||||||
tellDep dep = tell [makeUntyped dep]
|
|
||||||
|
|
||||||
genDependency' :: (Show u, Show a, Lift u, Lift a) => (Token a -> ComputationM' (Dependency u a)) -> ComputationM a
|
|
||||||
genDependency' f = do
|
|
||||||
top <- get
|
|
||||||
let top' = top + 1
|
|
||||||
target = Token top'
|
|
||||||
put top'
|
|
||||||
result <- f target
|
|
||||||
tellDep result
|
|
||||||
pure target
|
|
||||||
|
|
||||||
genDependency :: (Show u, Show a, Lift u, Lift a) => (Token a -> Dependency u a) -> ComputationM a
|
|
||||||
genDependency f = genDependency' (pure . f)
|
|
||||||
|
|
||||||
-- inject :: (Show a, Lift a) => a -> ComputationM a
|
|
||||||
-- inject x = genDependency (Dependency NoToken (Inject x))
|
|
||||||
|
|
||||||
inject :: (Show a, Lift a, Valuable a) => a -> ComputationM a
|
|
||||||
inject x = genDependency (Dependency NoToken (Inject (toValue x)))
|
|
||||||
|
|
||||||
-- inject' :: ImageConversionSettings -> ComputationM ImageConversionSettings
|
|
||||||
-- -- inject' x = genDependency (Dependency NoToken (InjectImageConversionSettings x))
|
|
||||||
-- inject' x = genDependency (Dependency NoToken (Inject WImageConversionSettings x))
|
|
||||||
|
|
||||||
getListElem :: (Show a, Lift a) => Token [a] -> ComputationM a
|
|
||||||
getListElem outer = genDependency (Dependency outer GetListElem)
|
|
||||||
|
|
||||||
setListElem :: (Show a, Lift a) => Token a -> Token [a] -> ComputationM ()
|
|
||||||
setListElem a outer = do
|
|
||||||
tellDep (Dependency a SetListElem outer)
|
|
||||||
pure NoToken
|
|
||||||
|
|
||||||
-- runFunction :: (Show a, Show b, Lift a, Lift b, IsFunction f a b) => f -> Token a -> ComputationM b
|
|
||||||
-- runFunction f input = genDependency (Dependency input (Function f))
|
|
||||||
|
|
||||||
-- runFunctionIO :: (Show a, Show b, Lift a, Lift b, IsFunctionIO f a b) => f -> Token a -> ComputationM b
|
|
||||||
-- runFunctionIO f input = genDependency (Dependency input (FunctionIO f))
|
|
||||||
|
|
||||||
runFunction :: (Show a, Show b, Lift a, Lift b) => Function -> Token a -> ComputationM b
|
|
||||||
runFunction f input = genDependency (Dependency input (Function f))
|
|
||||||
|
|
||||||
runFunctionIO :: (Show a, Show b, Lift a, Lift b) => FunctionIO -> Token a -> ComputationM b
|
|
||||||
runFunctionIO f input = genDependency (Dependency input (FunctionIO f))
|
|
||||||
|
|
||||||
mapComputationM :: (Show a, Show b, Lift a, Lift b) => (Token a -> ComputationM b) -> Token [a] -> ComputationM [b]
|
|
||||||
mapComputationM f input = genDependency' $ \target -> do
|
|
||||||
top <- get
|
|
||||||
let (res, top') = evalComputationM' top $ do
|
|
||||||
inp <- getListElem input
|
|
||||||
outp <- f inp
|
|
||||||
setListElem outp target
|
|
||||||
put top'
|
|
||||||
pure (Dependency input (MapComp res) target)
|
|
||||||
|
|
||||||
mapComputationM_ :: (Show a, Lift a) => (Token a -> ComputationM ()) -> Token [a] -> ComputationM ()
|
|
||||||
mapComputationM_ f input = do
|
|
||||||
_ <- mapComputationM f input
|
|
||||||
pure NoToken
|
|
||||||
|
|
||||||
filterComputationM :: (Show a, Lift a) => (Token a -> ComputationM Bool) -> Token [a] -> ComputationM [a]
|
|
||||||
filterComputationM f input = do
|
|
||||||
conds <- mapComputationM f input
|
|
||||||
genDependency (Dependency (TupleToken input conds) FilterComp)
|
|
|
@ -1,112 +1,42 @@
|
||||||
{-# LANGUAGE GADTs #-}
|
|
||||||
module Dependency
|
module Dependency
|
||||||
( TypedRun(..)
|
( Action(..)
|
||||||
|
, UToken(..)
|
||||||
, Dependency(..)
|
, Dependency(..)
|
||||||
, Token(..)
|
, makeDependency
|
||||||
, DependencyUntyped
|
|
||||||
, makeUntyped
|
|
||||||
, tupleTokens
|
|
||||||
, zipTokens
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types
|
import Types.Token (Token(..))
|
||||||
|
import Types.Value (Value)
|
||||||
|
import Types.Function (Function)
|
||||||
|
import Types.FunctionIO (FunctionIO)
|
||||||
|
|
||||||
-- import Unsafe.Coerce (unsafeCoerce)
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
|
|
||||||
-- data TypedRun a b where
|
data Action = Function Function
|
||||||
-- Function :: IsFunctionId f => f -> TypedRun a b
|
| FunctionIO FunctionIO
|
||||||
-- FunctionIO :: IsFunctionIOId f => f -> TypedRun a b
|
| Inject Value
|
||||||
-- Function :: IsFunction f a b => f -> TypedRun a b
|
| MapComp [Dependency]
|
||||||
-- FunctionIO :: IsFunctionIO f a b => f -> TypedRun a b
|
| FilterComp
|
||||||
-- Inject :: Lift b => b -> TypedRun () b
|
| GetListElem
|
||||||
-- GetListElem :: TypedRun [b] b
|
| SetListElem
|
||||||
-- SetListElem :: TypedRun a [a]
|
|
||||||
-- MapComp :: [DependencyUntyped] -> TypedRun [a] [b]
|
|
||||||
-- FilterComp :: TypedRun ([a], [Bool]) [a]
|
|
||||||
|
|
||||||
-- deriving instance (Show a, Show b) => Show (TypedRun a b)
|
|
||||||
-- deriving instance (Lift a, Lift b) => Lift (TypedRun a b)
|
|
||||||
|
|
||||||
-- data TypedRun where
|
|
||||||
-- -- Function :: IsFunctionId f => f -> TypedRun
|
|
||||||
-- -- FunctionIO :: IsFunctionIOId f => f -> TypedRun
|
|
||||||
-- Function :: Function -> TypedRun
|
|
||||||
-- FunctionIO :: FunctionIO -> TypedRun
|
|
||||||
-- -- Inject :: (Show b, Lift b) => b -> TypedRun
|
|
||||||
-- -- InjectString :: String -> TypedRun
|
|
||||||
-- -- InjectImageConversionSettings :: ImageConversionSettings -> TypedRun
|
|
||||||
-- -- Inject :: (Show a, Lift a, Witness w a) => w -> a -> TypedRun
|
|
||||||
-- Inject :: Value -> TypedRun
|
|
||||||
-- GetListElem :: TypedRun
|
|
||||||
-- SetListElem :: TypedRun
|
|
||||||
-- MapComp :: [DependencyUntyped] -> TypedRun
|
|
||||||
-- FilterComp :: TypedRun
|
|
||||||
|
|
||||||
-- deriving instance Show TypedRun
|
|
||||||
-- deriving instance Lift TypedRun
|
|
||||||
|
|
||||||
data TypedRun = Function Function
|
|
||||||
| FunctionIO FunctionIO
|
|
||||||
| Inject Value
|
|
||||||
| GetListElem
|
|
||||||
| SetListElem
|
|
||||||
| MapComp [DependencyUntyped]
|
|
||||||
| FilterComp
|
|
||||||
deriving (Show, Lift)
|
deriving (Show, Lift)
|
||||||
|
|
||||||
data Token a where
|
data UToken = UToken Int
|
||||||
Token :: Int -> Token a
|
| UTupleToken UToken UToken
|
||||||
TupleToken :: Token a -> Token b -> Token (a, b)
|
| UZipToken UToken UToken
|
||||||
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
|
| UNoToken
|
||||||
NoToken :: Token ()
|
|
||||||
|
|
||||||
deriving instance Show (Token a)
|
|
||||||
deriving instance Lift (Token a)
|
|
||||||
|
|
||||||
tupleTokens :: (Show a, Show b) => Token a -> Token b -> Token (a, b)
|
|
||||||
tupleTokens = TupleToken
|
|
||||||
|
|
||||||
zipTokens :: (Show a, Show b) => Token [a] -> Token [b] -> Token [(a, b)]
|
|
||||||
zipTokens = ZipToken
|
|
||||||
|
|
||||||
-- data Dependency a b = Dependency (Token a) (TypedRun a b) (Token b)
|
|
||||||
-- deriving (Show)
|
|
||||||
|
|
||||||
data Dependency a b = Dependency (Token a) TypedRun (Token b)
|
|
||||||
deriving (Show)
|
|
||||||
|
|
||||||
deriving instance (Lift a, Lift b) => Lift (Dependency a b)
|
|
||||||
|
|
||||||
-- type DependencyUntyped = Dependency () ()
|
|
||||||
|
|
||||||
-- makeUntyped :: (Show a, Show b, Lift a, Lift b) => Dependency a b -> DependencyUntyped
|
|
||||||
-- makeUntyped dep = unsafeCoerce dep
|
|
||||||
|
|
||||||
data TokenUntyped = UToken Int
|
|
||||||
| UTupleToken TokenUntyped TokenUntyped
|
|
||||||
| UZipToken TokenUntyped TokenUntyped
|
|
||||||
| UNoToken
|
|
||||||
deriving (Show, Lift)
|
deriving (Show, Lift)
|
||||||
|
|
||||||
makeUntypedToken :: Token a -> TokenUntyped
|
data Dependency = Dependency UToken Action UToken
|
||||||
makeUntypedToken = \case
|
deriving (Show, Lift)
|
||||||
|
|
||||||
|
makeDependency :: (Show a, Show b, Lift a, Lift b) => Token a -> Action -> Token b -> Dependency
|
||||||
|
makeDependency a action b = Dependency (makeUToken a) action (makeUToken b)
|
||||||
|
|
||||||
|
makeUToken :: Token a -> UToken
|
||||||
|
makeUToken = \case
|
||||||
Token i -> UToken i
|
Token i -> UToken i
|
||||||
TupleToken a b -> UTupleToken (makeUntypedToken a) (makeUntypedToken b)
|
TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b)
|
||||||
ZipToken a b -> UZipToken (makeUntypedToken a) (makeUntypedToken b)
|
ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
|
||||||
NoToken -> UNoToken
|
NoToken -> UNoToken
|
||||||
|
|
||||||
-- data DependencyUntyped where
|
|
||||||
-- DependencyUntyped :: TokenUntyped -> TypedRun -> TokenUntyped -> String -> DependencyUntyped
|
|
||||||
|
|
||||||
data DependencyUntyped = DependencyUntyped TokenUntyped TypedRun TokenUntyped
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
-- instance Show DependencyUntyped-- where
|
|
||||||
-- -- show (DependencyUntyped _ _ _ s) = s
|
|
||||||
|
|
||||||
-- instance Lift DependencyUntyped
|
|
||||||
|
|
||||||
makeUntyped :: (Show a, Show b, Lift a, Lift b) => Dependency a b -> DependencyUntyped
|
|
||||||
makeUntyped (Dependency ta tr tb) =
|
|
||||||
DependencyUntyped (makeUntypedToken ta) tr (makeUntypedToken tb)
|
|
||||||
|
|
|
@ -0,0 +1,115 @@
|
||||||
|
module DependencyGenerator
|
||||||
|
( DepGenM
|
||||||
|
, evalDepGenM
|
||||||
|
, inject
|
||||||
|
, runFunction
|
||||||
|
, runFunctionIO
|
||||||
|
, mapDepGenM
|
||||||
|
, mapDepGenM_
|
||||||
|
, filterDepGenM
|
||||||
|
|
||||||
|
, isImageFilename
|
||||||
|
, convertedImageFilename
|
||||||
|
, listDirectory
|
||||||
|
, readTemplate
|
||||||
|
, convertImage
|
||||||
|
, saveFile
|
||||||
|
, runPandoc
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Types.Token (Token(..))
|
||||||
|
import Types.Values
|
||||||
|
import Types.Value (Valuable(..))
|
||||||
|
import Types.Function (Function(..))
|
||||||
|
import Types.FunctionIO (FunctionIO(..))
|
||||||
|
import Dependency (Action(..), Dependency, makeDependency)
|
||||||
|
|
||||||
|
import Control.Monad.State (MonadState, State, runState, put, get)
|
||||||
|
import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell)
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
newtype DepGenM' a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
|
||||||
|
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
|
||||||
|
|
||||||
|
type DepGenM a = DepGenM' (Token a)
|
||||||
|
|
||||||
|
evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int)
|
||||||
|
evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top
|
||||||
|
|
||||||
|
evalDepGenM :: DepGenM () -> [Dependency]
|
||||||
|
evalDepGenM m = fst (evalDepGenM' 0 m)
|
||||||
|
|
||||||
|
tellDep :: Dependency -> DepGenM' ()
|
||||||
|
tellDep dep = tell [dep]
|
||||||
|
|
||||||
|
genDependencyM :: (Show a, Lift a) => (Token a -> DepGenM' Dependency) -> DepGenM a
|
||||||
|
genDependencyM f = do
|
||||||
|
top <- get
|
||||||
|
let top' = top + 1
|
||||||
|
target = Token top'
|
||||||
|
put top'
|
||||||
|
result <- f target
|
||||||
|
tellDep result
|
||||||
|
pure target
|
||||||
|
|
||||||
|
genDependency :: (Show a, Lift a) => (Token a -> Dependency) -> DepGenM a
|
||||||
|
genDependency f = genDependencyM (pure . f)
|
||||||
|
|
||||||
|
inject :: (Show a, Lift a, Valuable a) => a -> DepGenM a
|
||||||
|
inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
|
||||||
|
|
||||||
|
getListElem :: (Show a, Lift a) => Token [a] -> DepGenM a
|
||||||
|
getListElem outer = genDependency (makeDependency outer GetListElem)
|
||||||
|
|
||||||
|
setListElem :: (Show a, Lift a) => Token a -> Token [a] -> DepGenM ()
|
||||||
|
setListElem a outer = do
|
||||||
|
tellDep (makeDependency a SetListElem outer)
|
||||||
|
pure NoToken
|
||||||
|
|
||||||
|
runFunction :: (Show a, Show b, Lift a, Lift b) => Function -> Token a -> DepGenM b
|
||||||
|
runFunction f input = genDependency (makeDependency input (Function f))
|
||||||
|
|
||||||
|
runFunctionIO :: (Show a, Show b, Lift a, Lift b) => FunctionIO -> Token a -> DepGenM b
|
||||||
|
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
|
||||||
|
|
||||||
|
mapDepGenM :: (Show a, Show b, Lift a, Lift b) => (Token a -> DepGenM b) -> Token [a] -> DepGenM [b]
|
||||||
|
mapDepGenM f input = genDependencyM $ \target -> do
|
||||||
|
top <- get
|
||||||
|
let (res, top') = evalDepGenM' top $ do
|
||||||
|
inp <- getListElem input
|
||||||
|
outp <- f inp
|
||||||
|
setListElem outp target
|
||||||
|
put top'
|
||||||
|
pure (makeDependency input (MapComp res) target)
|
||||||
|
|
||||||
|
mapDepGenM_ :: (Show a, Lift a) => (Token a -> DepGenM ()) -> Token [a] -> DepGenM ()
|
||||||
|
mapDepGenM_ f input = do
|
||||||
|
_ <- mapDepGenM f input
|
||||||
|
pure NoToken
|
||||||
|
|
||||||
|
filterDepGenM :: (Show a, Lift a) => (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a]
|
||||||
|
filterDepGenM f input = do
|
||||||
|
conds <- mapDepGenM f input
|
||||||
|
genDependency (makeDependency (TupleToken input conds) FilterComp)
|
||||||
|
|
||||||
|
|
||||||
|
isImageFilename :: Token FilePath -> DepGenM Bool
|
||||||
|
isImageFilename = runFunction IsImageFilename
|
||||||
|
|
||||||
|
convertedImageFilename :: Token FilePath -> DepGenM FilePath
|
||||||
|
convertedImageFilename = runFunction ConvertedImageFilename
|
||||||
|
|
||||||
|
listDirectory :: Token FilePath -> DepGenM [FilePath]
|
||||||
|
listDirectory = runFunctionIO ListDirectory
|
||||||
|
|
||||||
|
readTemplate :: Token FilePath -> DepGenM Template
|
||||||
|
readTemplate = runFunctionIO ReadTemplate
|
||||||
|
|
||||||
|
convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM ()
|
||||||
|
convertImage = runFunctionIO ConvertImage
|
||||||
|
|
||||||
|
saveFile :: Token (String, FilePath) -> DepGenM ()
|
||||||
|
saveFile = runFunctionIO SaveFile
|
||||||
|
|
||||||
|
runPandoc :: Token String -> DepGenM String
|
||||||
|
runPandoc = runFunctionIO RunPandoc
|
|
@ -0,0 +1,8 @@
|
||||||
|
module Evaluation.Function
|
||||||
|
( evalFunction
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Types (Function(..))
|
||||||
|
|
||||||
|
evalFunction :: Function -> a -> b
|
||||||
|
evalFunction = undefined
|
|
@ -0,0 +1,8 @@
|
||||||
|
module Evaluation.FunctionIO
|
||||||
|
( evalFunctionIO
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Types (FunctionIO(..))
|
||||||
|
|
||||||
|
evalFunctionIO :: FunctionIO -> a -> b
|
||||||
|
evalFunctionIO = undefined
|
|
@ -1,37 +0,0 @@
|
||||||
module FunctionImplementations.IO
|
|
||||||
( -- ListDirectory(..)
|
|
||||||
-- , ReadTemplate(..)
|
|
||||||
-- , ConvertImage(..)
|
|
||||||
-- , SaveFile(..)
|
|
||||||
-- , RunPandoc(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Sources()
|
|
||||||
import Types
|
|
||||||
|
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
|
|
||||||
-- data ListDirectory = ListDirectory deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionIOId ListDirectory
|
|
||||||
-- instance IsFunctionIO ListDirectory FilePath [FilePath] where
|
|
||||||
-- runFIO ListDirectory _path = undefined
|
|
||||||
|
|
||||||
-- data ReadTemplate = ReadTemplate deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionIOId ReadTemplate
|
|
||||||
-- instance IsFunctionIO ReadTemplate FilePath Template where
|
|
||||||
-- runFIO ReadTemplate _path = undefined
|
|
||||||
|
|
||||||
-- data ConvertImage = ConvertImage deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionIOId ConvertImage
|
|
||||||
-- instance IsFunctionIO ConvertImage ((FilePath, FilePath), ImageConversionSettings) () where
|
|
||||||
-- runFIO ConvertImage ((_, _), ResizeToWidth _) = undefined
|
|
||||||
|
|
||||||
-- data SaveFile = SaveFile deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionIOId SaveFile
|
|
||||||
-- instance IsFunctionIO SaveFile (String, FilePath) () where
|
|
||||||
-- runFIO SaveFile _source = undefined
|
|
||||||
|
|
||||||
-- data RunPandoc = RunPandoc deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionIOId RunPandoc
|
|
||||||
-- instance IsFunctionIO RunPandoc String String where
|
|
||||||
-- runFIO RunPandoc _source = undefined
|
|
|
@ -1,19 +0,0 @@
|
||||||
module FunctionImplementations.Pure
|
|
||||||
( -- IsImageFilename(..)
|
|
||||||
-- , ConvertedImageFilename(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Sources()
|
|
||||||
import Types
|
|
||||||
|
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
|
|
||||||
-- data IsImageFilename = IsImageFilename deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionId IsImageFilename
|
|
||||||
-- instance IsFunction IsImageFilename FilePath Bool where
|
|
||||||
-- runF IsImageFilename _path = undefined
|
|
||||||
|
|
||||||
-- data ConvertedImageFilename = ConvertedImageFilename deriving (Show, Lift)
|
|
||||||
-- instance IsFunctionId ConvertedImageFilename
|
|
||||||
-- instance IsFunction ConvertedImageFilename FilePath FilePath where
|
|
||||||
-- runF ConvertedImageFilename _path = undefined
|
|
|
@ -1,32 +0,0 @@
|
||||||
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
|
||||||
module Functions
|
|
||||||
( isImageFilename
|
|
||||||
, convertedImageFilename
|
|
||||||
, listDirectory
|
|
||||||
, readTemplate
|
|
||||||
, convertImage
|
|
||||||
, saveFile
|
|
||||||
, runPandoc
|
|
||||||
) where
|
|
||||||
|
|
||||||
import FunctionImplementations.Pure
|
|
||||||
import FunctionImplementations.IO
|
|
||||||
import ComputationM
|
|
||||||
import Types
|
|
||||||
import Dependency
|
|
||||||
|
|
||||||
isImageFilename :: Token FilePath -> ComputationM Bool
|
|
||||||
isImageFilename = runFunction IsImageFilename
|
|
||||||
convertedImageFilename :: Token FilePath -> ComputationM FilePath
|
|
||||||
convertedImageFilename = runFunction ConvertedImageFilename
|
|
||||||
|
|
||||||
listDirectory :: Token FilePath -> ComputationM [FilePath]
|
|
||||||
listDirectory = runFunctionIO ListDirectory
|
|
||||||
readTemplate :: Token FilePath -> ComputationM Template
|
|
||||||
readTemplate = runFunctionIO ReadTemplate
|
|
||||||
convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> ComputationM ()
|
|
||||||
convertImage = runFunctionIO ConvertImage
|
|
||||||
saveFile :: Token (String, FilePath) -> ComputationM ()
|
|
||||||
saveFile = runFunctionIO SaveFile
|
|
||||||
runPandoc :: Token String -> ComputationM String
|
|
||||||
runPandoc = runFunctionIO RunPandoc
|
|
|
@ -1,24 +0,0 @@
|
||||||
module Generator (generate) where
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Dependency
|
|
||||||
import ComputationM
|
|
||||||
import Functions
|
|
||||||
|
|
||||||
handleRecipeDir :: Token Template -> Token FilePath -> ComputationM ()
|
|
||||||
handleRecipeDir _template dir = do
|
|
||||||
dirContents <- listDirectory dir
|
|
||||||
imageFilenames <- filterComputationM isImageFilename dirContents
|
|
||||||
convertedImageFilenames <- mapComputationM convertedImageFilename imageFilenames
|
|
||||||
flip mapComputationM_ (zipTokens imageFilenames convertedImageFilenames) $ \files -> do
|
|
||||||
settings <- inject $ ResizeToWidth 800
|
|
||||||
convertImage $ tupleTokens files settings
|
|
||||||
|
|
||||||
generate :: ComputationM ()
|
|
||||||
generate = do
|
|
||||||
templateFilename <- inject "template.html"
|
|
||||||
template <- readTemplate templateFilename
|
|
||||||
dir <- inject "retter"
|
|
||||||
dirContents <- listDirectory dir
|
|
||||||
mapComputationM_ (handleRecipeDir template) dirContents
|
|
||||||
|
|
|
@ -1,14 +1,14 @@
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Dependency
|
import Types (Dependency)
|
||||||
import ComputationM
|
import DependencyGenerator (evalDepGenM)
|
||||||
import Generator
|
import SiteGenerator (generateSite)
|
||||||
|
|
||||||
import Language.Haskell.TH.Syntax
|
import Language.Haskell.TH.Syntax (lift)
|
||||||
|
|
||||||
dependencies :: [DependencyUntyped]
|
dependencies :: [Dependency]
|
||||||
dependencies = $(lift (evalComputationM generate))
|
dependencies = $(lift (evalDepGenM generateSite))
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = mapM_ print dependencies
|
main = mapM_ print dependencies
|
||||||
|
|
|
@ -0,0 +1,22 @@
|
||||||
|
module SiteGenerator (generateSite) where
|
||||||
|
|
||||||
|
import Types
|
||||||
|
import DependencyGenerator
|
||||||
|
|
||||||
|
handleRecipeDir :: Token Template -> Token FilePath -> DepGenM ()
|
||||||
|
handleRecipeDir _template dir = do
|
||||||
|
dirContents <- listDirectory dir
|
||||||
|
imageFilenames <- filterDepGenM isImageFilename dirContents
|
||||||
|
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
|
||||||
|
flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do
|
||||||
|
settings <- inject $ ResizeToWidth 800
|
||||||
|
convertImage $ TupleToken files settings
|
||||||
|
|
||||||
|
generateSite :: DepGenM ()
|
||||||
|
generateSite = do
|
||||||
|
templateFilename <- inject "template.html"
|
||||||
|
template <- readTemplate templateFilename
|
||||||
|
dir <- inject "retter"
|
||||||
|
dirContents <- listDirectory dir
|
||||||
|
mapDepGenM_ (handleRecipeDir template) dirContents
|
||||||
|
|
|
@ -1,18 +0,0 @@
|
||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
||||||
module Sources where
|
|
||||||
|
|
||||||
-- TODO: Figure out if any of this is useful.
|
|
||||||
|
|
||||||
import Types
|
|
||||||
|
|
||||||
-- data Source a where
|
|
||||||
-- Data :: a -> Source a
|
|
||||||
|
|
||||||
-- instance SourceState FilePath where
|
|
||||||
-- stateOfSource = undefined
|
|
||||||
|
|
||||||
-- instance SourceState ((FilePath, FilePath), ImageConversionSettings) where
|
|
||||||
-- stateOfSource = undefined
|
|
||||||
|
|
||||||
-- instance SourceState (String, FilePath) where
|
|
||||||
-- stateOfSource = undefined
|
|
|
@ -1,58 +1,15 @@
|
||||||
{-# LANGUAGE FunctionalDependencies #-}
|
module Types
|
||||||
module Types where
|
( module Types.Token
|
||||||
|
, module Types.Values
|
||||||
|
, module Types.Value
|
||||||
|
, module Types.Function
|
||||||
|
, module Types.FunctionIO
|
||||||
|
, Dependency
|
||||||
|
) where
|
||||||
|
|
||||||
import Data.ByteString (ByteString)
|
import Types.Token
|
||||||
import Language.Haskell.TH.Syntax
|
import Types.Values
|
||||||
|
import Types.Value
|
||||||
data ImageConversionSettings = ResizeToWidth Int
|
import Types.Function
|
||||||
deriving (Show, Lift)
|
import Types.FunctionIO
|
||||||
|
import Dependency
|
||||||
data TemplatePart = Literal String
|
|
||||||
| KeyValue String
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
data Template = Template [TemplatePart]
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
-- class (Show f, Lift f) => IsFunctionId f
|
|
||||||
|
|
||||||
-- class (IsFunctionId f, SourceState a) => IsFunction f a b | f -> a b where
|
|
||||||
-- runF :: f -> a -> b
|
|
||||||
|
|
||||||
-- class (Show f, Lift f) => IsFunctionIOId f
|
|
||||||
-- class (IsFunctionIOId f, SourceState a) => IsFunctionIO f a b | f -> a b where
|
|
||||||
-- runFIO :: f -> a -> IO b
|
|
||||||
|
|
||||||
-- class SourceState a where
|
|
||||||
-- stateOfSource :: a -> IO ByteString
|
|
||||||
|
|
||||||
|
|
||||||
data Function = IsImageFilename
|
|
||||||
| ConvertedImageFilename
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
data FunctionIO = ListDirectory
|
|
||||||
| ReadTemplate
|
|
||||||
| ConvertImage
|
|
||||||
| SaveFile
|
|
||||||
| RunPandoc
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
|
|
||||||
-- class (Show w, Lift w) => Witness w a | w -> a where
|
|
||||||
|
|
||||||
-- data WImageConversionSettings = WImageConversionSettings deriving (Show, Lift)
|
|
||||||
-- instance Witness WImageConversionSettings ImageConversionSettings
|
|
||||||
|
|
||||||
data Value = ImageConversionSettings ImageConversionSettings
|
|
||||||
| String String
|
|
||||||
deriving (Show, Lift)
|
|
||||||
|
|
||||||
class Valuable a where
|
|
||||||
toValue :: a -> Value
|
|
||||||
|
|
||||||
instance Valuable ImageConversionSettings where
|
|
||||||
toValue = ImageConversionSettings
|
|
||||||
|
|
||||||
instance Valuable String where
|
|
||||||
toValue = String
|
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
module Types.Function
|
||||||
|
( Function(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
data Function = IsImageFilename
|
||||||
|
| ConvertedImageFilename
|
||||||
|
deriving (Show, Lift)
|
||||||
|
|
|
@ -0,0 +1,12 @@
|
||||||
|
module Types.FunctionIO
|
||||||
|
( FunctionIO(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
data FunctionIO = ListDirectory
|
||||||
|
| ReadTemplate
|
||||||
|
| ConvertImage
|
||||||
|
| SaveFile
|
||||||
|
| RunPandoc
|
||||||
|
deriving (Show, Lift)
|
|
@ -0,0 +1,15 @@
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
module Types.Token
|
||||||
|
( Token(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
data Token a where
|
||||||
|
Token :: Int -> Token a
|
||||||
|
TupleToken :: Token a -> Token b -> Token (a, b)
|
||||||
|
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
|
||||||
|
NoToken :: Token ()
|
||||||
|
|
||||||
|
deriving instance Show (Token a)
|
||||||
|
deriving instance Lift (Token a)
|
|
@ -0,0 +1,21 @@
|
||||||
|
module Types.Value
|
||||||
|
( Value(..)
|
||||||
|
, Valuable(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Types.Values
|
||||||
|
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
data Value = String String
|
||||||
|
| ImageConversionSettings ImageConversionSettings
|
||||||
|
deriving (Show, Lift)
|
||||||
|
|
||||||
|
class Valuable a where
|
||||||
|
toValue :: a -> Value
|
||||||
|
|
||||||
|
instance Valuable String where
|
||||||
|
toValue = String
|
||||||
|
|
||||||
|
instance Valuable ImageConversionSettings where
|
||||||
|
toValue = ImageConversionSettings
|
|
@ -0,0 +1,17 @@
|
||||||
|
module Types.Values
|
||||||
|
( ImageConversionSettings(..)
|
||||||
|
, TemplatePart(..)
|
||||||
|
, Template(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
|
data ImageConversionSettings = ResizeToWidth Int
|
||||||
|
deriving (Show, Lift)
|
||||||
|
|
||||||
|
data TemplatePart = Literal String
|
||||||
|
| KeyValue String
|
||||||
|
deriving (Show, Lift)
|
||||||
|
|
||||||
|
data Template = Template [TemplatePart]
|
||||||
|
deriving (Show, Lift)
|
Loading…
Reference in New Issue