Clean up and move things around
Šī revīzija ir iekļauta:
		@@ -17,14 +17,17 @@ library
 | 
			
		||||
    import: common
 | 
			
		||||
    hs-source-dirs: src
 | 
			
		||||
    exposed-modules:
 | 
			
		||||
        Types.Token
 | 
			
		||||
        Types.Values
 | 
			
		||||
        Types.Value
 | 
			
		||||
        Types.Function
 | 
			
		||||
        Types.FunctionIO
 | 
			
		||||
        Types
 | 
			
		||||
        Sources
 | 
			
		||||
        FunctionImplementations.Pure
 | 
			
		||||
        FunctionImplementations.IO
 | 
			
		||||
        Dependency
 | 
			
		||||
        ComputationM
 | 
			
		||||
        Functions
 | 
			
		||||
        Generator
 | 
			
		||||
        DependencyGenerator
 | 
			
		||||
        Evaluation.Function
 | 
			
		||||
        Evaluation.FunctionIO
 | 
			
		||||
        SiteGenerator
 | 
			
		||||
    build-depends:
 | 
			
		||||
        base
 | 
			
		||||
      , 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
 | 
			
		||||
  ( TypedRun(..)
 | 
			
		||||
  ( Action(..)
 | 
			
		||||
  , UToken(..)
 | 
			
		||||
  , Dependency(..)
 | 
			
		||||
  , Token(..)
 | 
			
		||||
  , DependencyUntyped
 | 
			
		||||
  , makeUntyped
 | 
			
		||||
  , tupleTokens
 | 
			
		||||
  , zipTokens
 | 
			
		||||
  , makeDependency
 | 
			
		||||
  ) 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
 | 
			
		||||
import Language.Haskell.TH.Syntax (Lift)
 | 
			
		||||
 | 
			
		||||
-- data TypedRun a b where
 | 
			
		||||
--   Function :: IsFunctionId f => f -> TypedRun a b
 | 
			
		||||
--   FunctionIO :: IsFunctionIOId f => f -> TypedRun a b
 | 
			
		||||
--   Function :: IsFunction f a b => f -> TypedRun a b
 | 
			
		||||
--   FunctionIO :: IsFunctionIO f a b => f -> TypedRun a b
 | 
			
		||||
--   Inject :: Lift b => b -> TypedRun () b
 | 
			
		||||
--   GetListElem :: TypedRun [b] b
 | 
			
		||||
--   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
 | 
			
		||||
data Action = Function Function
 | 
			
		||||
            | FunctionIO FunctionIO
 | 
			
		||||
            | Inject Value
 | 
			
		||||
            | MapComp [Dependency]
 | 
			
		||||
            | FilterComp
 | 
			
		||||
            | GetListElem
 | 
			
		||||
            | SetListElem
 | 
			
		||||
  deriving (Show, 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)
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
data UToken = UToken Int
 | 
			
		||||
            | UTupleToken UToken UToken
 | 
			
		||||
            | UZipToken UToken UToken
 | 
			
		||||
            | UNoToken
 | 
			
		||||
  deriving (Show, Lift)
 | 
			
		||||
 | 
			
		||||
makeUntypedToken :: Token a -> TokenUntyped
 | 
			
		||||
makeUntypedToken = \case
 | 
			
		||||
data Dependency = Dependency UToken Action UToken
 | 
			
		||||
  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
 | 
			
		||||
  TupleToken a b -> UTupleToken (makeUntypedToken a) (makeUntypedToken b)
 | 
			
		||||
  ZipToken a b -> UZipToken (makeUntypedToken a) (makeUntypedToken b)
 | 
			
		||||
  TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b)
 | 
			
		||||
  ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
 | 
			
		||||
  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)
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										115
									
								
								byg/src/DependencyGenerator.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										115
									
								
								byg/src/DependencyGenerator.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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
 | 
			
		||||
							
								
								
									
										8
									
								
								byg/src/Evaluation/Function.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										8
									
								
								byg/src/Evaluation/Function.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -0,0 +1,8 @@
 | 
			
		||||
module Evaluation.Function
 | 
			
		||||
  ( evalFunction
 | 
			
		||||
  ) where
 | 
			
		||||
 | 
			
		||||
import Types (Function(..))
 | 
			
		||||
 | 
			
		||||
evalFunction :: Function -> a -> b
 | 
			
		||||
evalFunction = undefined
 | 
			
		||||
							
								
								
									
										8
									
								
								byg/src/Evaluation/FunctionIO.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										8
									
								
								byg/src/Evaluation/FunctionIO.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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 #-}
 | 
			
		||||
module Main where
 | 
			
		||||
 | 
			
		||||
import Dependency
 | 
			
		||||
import ComputationM
 | 
			
		||||
import Generator
 | 
			
		||||
import Types (Dependency)
 | 
			
		||||
import DependencyGenerator (evalDepGenM)
 | 
			
		||||
import SiteGenerator (generateSite)
 | 
			
		||||
 | 
			
		||||
import Language.Haskell.TH.Syntax
 | 
			
		||||
import Language.Haskell.TH.Syntax (lift)
 | 
			
		||||
 | 
			
		||||
dependencies :: [DependencyUntyped]
 | 
			
		||||
dependencies = $(lift (evalComputationM generate))
 | 
			
		||||
dependencies :: [Dependency]
 | 
			
		||||
dependencies = $(lift (evalDepGenM generateSite))
 | 
			
		||||
 | 
			
		||||
main :: IO ()
 | 
			
		||||
main = mapM_ print dependencies
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										22
									
								
								byg/src/SiteGenerator.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										22
									
								
								byg/src/SiteGenerator.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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 where
 | 
			
		||||
module Types
 | 
			
		||||
  ( module Types.Token
 | 
			
		||||
  , module Types.Values
 | 
			
		||||
  , module Types.Value
 | 
			
		||||
  , module Types.Function
 | 
			
		||||
  , module Types.FunctionIO
 | 
			
		||||
  , Dependency
 | 
			
		||||
  ) where
 | 
			
		||||
 | 
			
		||||
import Data.ByteString (ByteString)
 | 
			
		||||
import Language.Haskell.TH.Syntax
 | 
			
		||||
 | 
			
		||||
data ImageConversionSettings = ResizeToWidth Int
 | 
			
		||||
  deriving (Show, Lift)
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
import Types.Token
 | 
			
		||||
import Types.Values
 | 
			
		||||
import Types.Value
 | 
			
		||||
import Types.Function
 | 
			
		||||
import Types.FunctionIO
 | 
			
		||||
import Dependency
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										10
									
								
								byg/src/Types/Function.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										10
									
								
								byg/src/Types/Function.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -0,0 +1,10 @@
 | 
			
		||||
module Types.Function
 | 
			
		||||
  ( Function(..)
 | 
			
		||||
  ) where
 | 
			
		||||
 | 
			
		||||
import Language.Haskell.TH.Syntax (Lift)
 | 
			
		||||
 | 
			
		||||
data Function = IsImageFilename
 | 
			
		||||
              | ConvertedImageFilename
 | 
			
		||||
  deriving (Show, Lift)
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										12
									
								
								byg/src/Types/FunctionIO.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										12
									
								
								byg/src/Types/FunctionIO.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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)
 | 
			
		||||
							
								
								
									
										15
									
								
								byg/src/Types/Token.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										15
									
								
								byg/src/Types/Token.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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)
 | 
			
		||||
							
								
								
									
										21
									
								
								byg/src/Types/Value.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										21
									
								
								byg/src/Types/Value.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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
 | 
			
		||||
							
								
								
									
										17
									
								
								byg/src/Types/Values.hs
									
									
									
									
									
										Parasts fails
									
								
							
							
						
						
									
										17
									
								
								byg/src/Types/Values.hs
									
									
									
									
									
										Parasts fails
									
								
							@@ -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)
 | 
			
		||||
		Atsaukties uz šo jaunā problēmā
	
	Block a user