Change Value type to just be Dynamic
Restructure into more modules.
This commit is contained in:
parent
41fc74eb98
commit
f348bd1e82
|
|
@ -21,15 +21,18 @@ library
|
|||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
Types.Token
|
||||
Types.Values
|
||||
Types.Value
|
||||
Types.Function
|
||||
Types.FunctionIO
|
||||
Types.Functions
|
||||
Types.Dependency
|
||||
Types
|
||||
DependencyGenerator
|
||||
Function
|
||||
FunctionIO
|
||||
Functions.General
|
||||
Functions.Image
|
||||
Functions.Pandoc
|
||||
Functions.Paths
|
||||
Functions.Template
|
||||
Functions.Text
|
||||
Functions
|
||||
DependencyRunner
|
||||
SiteGenerator
|
||||
Precomputer
|
||||
|
|
@ -50,5 +53,4 @@ executable byg
|
|||
main-is: src/Main.hs
|
||||
build-depends:
|
||||
base >=4.14 && <4.20
|
||||
, text
|
||||
, byg
|
||||
|
|
|
|||
|
|
@ -25,12 +25,9 @@ module DependencyGenerator
|
|||
, unzipDepGenM
|
||||
) where
|
||||
|
||||
import Prelude hiding (String, FilePath)
|
||||
|
||||
import Types.Token (Token(..))
|
||||
import Types.Value (Valuable(..))
|
||||
import Types.FunctionIO (IsFunctionIO(..))
|
||||
import Types.Function (IsFunction(..))
|
||||
import Types.Functions (IsFunction(), IsFunctionIO(..))
|
||||
import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken)
|
||||
|
||||
import Control.Monad.State (MonadState, State, runState, put, get)
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ module DependencyRunner
|
|||
, runDepRunMIO
|
||||
) where
|
||||
|
||||
import Types (Value(..), Valuable(..), evalFunction, evalFunctionIO)
|
||||
import Types (Value(..), fromValue, toValue, evalFunction, evalFunctionIO)
|
||||
import Types.Dependency
|
||||
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad (void)
|
||||
import Control.Monad (void, forM)
|
||||
import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
|
||||
|
||||
data ValueExistence = Evaluated Value
|
||||
|
|
@ -46,6 +46,12 @@ runDep (Dependency a action b) =
|
|||
putStrLn "----------"
|
||||
pure result
|
||||
|
||||
foo' :: [Value] -> [Value] -> [(Value, Value)]
|
||||
foo' = zip
|
||||
|
||||
foo :: Value -> Value -> Value
|
||||
foo va vb = toValue $ foo' (fromValue va) (fromValue vb)
|
||||
|
||||
getTokenValue :: UToken -> DepRunM Value
|
||||
getTokenValue = \case
|
||||
UToken i -> do
|
||||
|
|
@ -54,20 +60,16 @@ getTokenValue = \case
|
|||
UTupleToken a b -> do
|
||||
va <- getTokenValue a
|
||||
vb <- getTokenValue b
|
||||
pure $ Tuple (va, vb)
|
||||
pure $ toValue (va, vb)
|
||||
UZipToken a b -> do
|
||||
va <- getTokenValue a
|
||||
vb <- getTokenValue b
|
||||
case (va, vb) of
|
||||
(List as, List bs) ->
|
||||
pure $ List $ zipWith (curry Tuple) as bs
|
||||
_ ->
|
||||
error "unexpected"
|
||||
pure $ foo va vb
|
||||
UListToken ts -> do
|
||||
vs <- mapM getTokenValue ts
|
||||
pure $ List vs
|
||||
pure $ toValue vs
|
||||
UNoToken ->
|
||||
pure Empty
|
||||
pure $ toValue ()
|
||||
|
||||
putTokenValue :: UToken -> ValueExistence -> DepRunM ()
|
||||
putTokenValue t e = case t of
|
||||
|
|
@ -87,41 +89,18 @@ runAction action input = case action of
|
|||
Inject v ->
|
||||
pure v
|
||||
FilterComp ->
|
||||
case input of
|
||||
Tuple (List vs, List mask) ->
|
||||
pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask
|
||||
_ ->
|
||||
error "unexpected"
|
||||
let (vs, mask) = fromValue input :: ([Value], [Value])
|
||||
in pure $ toValue $ map fst $ filter (fromValue . snd) $ zip vs mask
|
||||
UntupleFst ->
|
||||
case input of
|
||||
Tuple (v, _) ->
|
||||
pure v
|
||||
_ ->
|
||||
error "unexpected"
|
||||
pure $ fst (fromValue input :: (Value, Value))
|
||||
UntupleSnd ->
|
||||
case input of
|
||||
Tuple (_, v) ->
|
||||
pure v
|
||||
_ ->
|
||||
error "unexpected"
|
||||
pure $ snd (fromValue input :: (Value, Value))
|
||||
UnzipFst ->
|
||||
case input of
|
||||
List vs ->
|
||||
List <$> mapM (runAction UntupleFst) vs
|
||||
_ ->
|
||||
error "unexpected"
|
||||
toValue <$> mapM (runAction UntupleFst) (fromValue input :: [Value])
|
||||
UnzipSnd ->
|
||||
case input of
|
||||
List vs ->
|
||||
List <$> mapM (runAction UntupleSnd) vs
|
||||
_ ->
|
||||
error "unexpected"
|
||||
toValue <$> mapM (runAction UntupleSnd) (fromValue input :: [Value])
|
||||
MapComp subDeps innerInput innerOutput ->
|
||||
case input of
|
||||
List vs ->
|
||||
(List <$>) $ flip mapM vs $ \v -> do
|
||||
putTokenValue innerInput $ Evaluated v
|
||||
runDeps subDeps
|
||||
getTokenValue innerOutput
|
||||
_ ->
|
||||
error "unexpected"
|
||||
(toValue <$>) $ forM (fromValue input :: [Value]) $ \v -> do
|
||||
putTokenValue innerInput $ Evaluated v
|
||||
runDeps subDeps
|
||||
getTokenValue innerOutput
|
||||
|
|
|
|||
|
|
@ -1,139 +0,0 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
module Function
|
||||
( concatStrings
|
||||
, concatTexts
|
||||
, joinPaths
|
||||
, fileComponents
|
||||
, lowerString
|
||||
, elemOf
|
||||
, makeTemplate
|
||||
, applyTemplate
|
||||
, toText
|
||||
, convertImage
|
||||
, runPandoc
|
||||
) where
|
||||
|
||||
import Prelude hiding (String, FilePath)
|
||||
|
||||
import Types.Values
|
||||
import Types.Value (Valuable)
|
||||
import Types.Function
|
||||
import Types.Token (Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
|
||||
|
||||
import Type.Reflection (Typeable, TypeRep, typeRep)
|
||||
import qualified Codec.Picture as CP
|
||||
import qualified Codec.Picture.STBIR as CPS
|
||||
import Data.Char (toLower)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Text.Pandoc as P
|
||||
import qualified Text.Blaze.Html.Renderer.Text as B
|
||||
|
||||
|
||||
data ConcatStrings = ConcatStrings deriving Show
|
||||
instance IsFunction ConcatStrings [String] String where
|
||||
evalFunction ConcatStrings = StringWrapper . concatMap unStringWrapper
|
||||
|
||||
concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
|
||||
concatStrings a = runFunction ConcatStrings =<< toToken a
|
||||
|
||||
|
||||
data ConcatTexts = ConcatTexts deriving Show
|
||||
instance IsFunction ConcatTexts [Text] Text where
|
||||
evalFunction ConcatTexts = T.concat
|
||||
|
||||
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
|
||||
concatTexts a = runFunction ConcatTexts =<< toToken a
|
||||
|
||||
|
||||
data JoinPaths = JoinPaths deriving Show
|
||||
instance IsFunction JoinPaths (FilePath, FilePath) FilePath where
|
||||
evalFunction JoinPaths (StringWrapper s0, StringWrapper s1) = StringWrapper (s0 ++ "/" ++ s1)
|
||||
|
||||
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
|
||||
joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
|
||||
|
||||
|
||||
data FileComponents = FileComponents deriving Show
|
||||
instance IsFunction FileComponents FilePath (String, String) where
|
||||
evalFunction FileComponents (StringWrapper s) =
|
||||
let (lastRev, firstRev) = span (/= '.') $ reverse s
|
||||
(base, ext) = case firstRev of
|
||||
_ : firstRev' -> (reverse firstRev', reverse lastRev)
|
||||
[] -> (reverse lastRev, "")
|
||||
in (StringWrapper base, StringWrapper ext)
|
||||
|
||||
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
|
||||
fileComponents a = runFunction FileComponents =<< toToken a
|
||||
|
||||
|
||||
data LowerString = LowerString deriving Show
|
||||
instance IsFunction LowerString String String where
|
||||
evalFunction LowerString (StringWrapper s) = StringWrapper (map toLower s)
|
||||
|
||||
lowerString :: TokenableTo String a => a -> DepGenM (Token String)
|
||||
lowerString a = runFunction LowerString =<< toToken a
|
||||
|
||||
|
||||
data ElemOf a where ElemOf :: TypeRep a -> ElemOf a
|
||||
deriving instance Show (ElemOf a)
|
||||
instance (Show a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
|
||||
evalFunction (ElemOf _) (y, ys) = y `elem` ys
|
||||
|
||||
elemOf :: forall t a b. (Show t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, Typeable t) => a -> b -> DepGenM (Token Bool)
|
||||
elemOf a b = runFunction (ElemOf (typeRep :: TypeRep t)) =<< toTupleToken a b
|
||||
|
||||
|
||||
data MakeTemplate = MakeTemplate deriving Show
|
||||
instance IsFunction MakeTemplate (Text, Text) Template where
|
||||
evalFunction MakeTemplate (t, c) =
|
||||
let (beforeContent, after) = T.breakOn c t
|
||||
afterContent = T.drop (T.length c) after
|
||||
in TemplateParts beforeContent afterContent
|
||||
|
||||
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
|
||||
makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
|
||||
|
||||
|
||||
data ApplyTemplate = ApplyTemplate deriving Show
|
||||
instance IsFunction ApplyTemplate (Template, Text) Text where
|
||||
evalFunction ApplyTemplate (TemplateParts beforeContent afterContent, t) =
|
||||
T.concat [beforeContent, t, afterContent]
|
||||
|
||||
applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
|
||||
applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
|
||||
|
||||
|
||||
data ToText = ToText deriving Show
|
||||
instance IsFunction ToText String Text where
|
||||
evalFunction ToText (StringWrapper s) = T.pack s
|
||||
|
||||
toText :: TokenableTo String a => a -> DepGenM (Token Text)
|
||||
toText a = runFunction ToText =<< toToken a
|
||||
|
||||
|
||||
data ConvertImage = ConvertImage deriving Show
|
||||
instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where
|
||||
evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) =
|
||||
let sizeFactor :: Double
|
||||
sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
|
||||
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
|
||||
in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image
|
||||
|
||||
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
|
||||
convertImage a b = runFunction ConvertImage =<< toTupleToken a b
|
||||
|
||||
|
||||
data RunPandoc = RunPandoc deriving Show
|
||||
instance IsFunction RunPandoc Text Text where
|
||||
evalFunction RunPandoc contents =
|
||||
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
|
||||
m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
|
||||
in case P.runPure m of
|
||||
Left e -> error ("unexpected pandoc error: " ++ show e)
|
||||
Right html -> TL.toStrict $ B.renderHtml html
|
||||
|
||||
runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text)
|
||||
runPandoc a = runFunction RunPandoc =<< toToken a
|
||||
|
|
@ -1,105 +0,0 @@
|
|||
module FunctionIO
|
||||
( listDirectory
|
||||
, isDirectory
|
||||
, readTextFile
|
||||
, openImage
|
||||
, saveImage
|
||||
, saveTextFile
|
||||
, copyFile
|
||||
, makeDir
|
||||
) where
|
||||
|
||||
import Prelude hiding (String, FilePath)
|
||||
|
||||
import Types.Values
|
||||
import Types.FunctionIO
|
||||
import Types.Token (Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunctionIO, runFunctionIO_)
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Codec.Picture as CP
|
||||
import qualified System.Directory as SD
|
||||
|
||||
|
||||
data ListDirectory = ListDirectory deriving Show
|
||||
instance IsFunctionIO ListDirectory FilePath [FilePath] where
|
||||
evalFunctionIO ListDirectory (StringWrapper s) =
|
||||
map StringWrapper <$> SD.listDirectory s
|
||||
functionIOTouchesFilesystem ListDirectory = False
|
||||
|
||||
listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath])
|
||||
listDirectory a = runFunctionIO ListDirectory =<< toToken a
|
||||
|
||||
|
||||
data IsDirectory = IsDirectory deriving Show
|
||||
instance IsFunctionIO IsDirectory FilePath Bool where
|
||||
evalFunctionIO IsDirectory (StringWrapper s) =
|
||||
SD.doesDirectoryExist s
|
||||
functionIOTouchesFilesystem IsDirectory = False
|
||||
|
||||
isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool)
|
||||
isDirectory a = runFunctionIO IsDirectory =<< toToken a
|
||||
|
||||
|
||||
data ReadTextFile = ReadTextFile deriving Show
|
||||
instance IsFunctionIO ReadTextFile FilePath Text where
|
||||
evalFunctionIO ReadTextFile (StringWrapper s) =
|
||||
T.readFile s
|
||||
functionIOTouchesFilesystem ReadTextFile = False
|
||||
|
||||
readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text)
|
||||
readTextFile a = runFunctionIO ReadTextFile =<< toToken a
|
||||
|
||||
|
||||
data OpenImage = OpenImage deriving Show
|
||||
instance IsFunctionIO OpenImage FilePath Image where
|
||||
evalFunctionIO OpenImage (StringWrapper s) = do
|
||||
imageOrig <- CP.readImage s
|
||||
case imageOrig of
|
||||
Left e -> error ("unexpected error: " ++ e)
|
||||
Right image -> pure $ ImageWrapper $ CP.convertRGB8 image
|
||||
functionIOTouchesFilesystem OpenImage = False
|
||||
|
||||
openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image)
|
||||
openImage a = runFunctionIO OpenImage =<< toToken a
|
||||
|
||||
|
||||
data SaveImage = SaveImage deriving Show
|
||||
instance IsFunctionIO SaveImage (Image, FilePath) () where
|
||||
evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) =
|
||||
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
|
||||
functionIOTouchesFilesystem SaveImage = True
|
||||
|
||||
saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
|
||||
|
||||
|
||||
data SaveTextFile = SaveTextFile deriving Show
|
||||
instance IsFunctionIO SaveTextFile (Text, FilePath) () where
|
||||
evalFunctionIO SaveTextFile (t, StringWrapper s) =
|
||||
T.writeFile s t
|
||||
functionIOTouchesFilesystem SaveTextFile = True
|
||||
|
||||
saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b
|
||||
|
||||
|
||||
data CopyFile = CopyFile deriving Show
|
||||
instance IsFunctionIO CopyFile (FilePath, FilePath) () where
|
||||
evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) =
|
||||
SD.copyFile source target
|
||||
functionIOTouchesFilesystem CopyFile = True
|
||||
|
||||
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b
|
||||
|
||||
|
||||
data MakeDir = MakeDir deriving Show
|
||||
instance IsFunctionIO MakeDir FilePath () where
|
||||
evalFunctionIO MakeDir (StringWrapper s) =
|
||||
SD.createDirectory s
|
||||
functionIOTouchesFilesystem MakeDir = True
|
||||
|
||||
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
|
||||
makeDir a = runFunctionIO_ MakeDir =<< toToken a
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
module Functions
|
||||
( module Functions.General
|
||||
, module Functions.Image
|
||||
, module Functions.Pandoc
|
||||
, module Functions.Paths
|
||||
, module Functions.Template
|
||||
, module Functions.Text
|
||||
) where
|
||||
|
||||
import Functions.General
|
||||
import Functions.Image
|
||||
import Functions.Pandoc
|
||||
import Functions.Paths
|
||||
import Functions.Template
|
||||
import Functions.Text
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
module Functions.General
|
||||
( elemOf
|
||||
) where
|
||||
|
||||
import Types (Valuable, IsFunction(..), Token)
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
|
||||
|
||||
import Type.Reflection (Typeable, TypeRep, typeRep)
|
||||
|
||||
|
||||
data ElemOf a where ElemOf :: TypeRep a -> ElemOf a
|
||||
deriving instance Show (ElemOf a)
|
||||
instance (Show a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
|
||||
evalFunction (ElemOf _) (y, ys) = y `elem` ys
|
||||
|
||||
elemOf :: forall t a b. (Show t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, Typeable t) => a -> b -> DepGenM (Token Bool)
|
||||
elemOf a b = runFunction (ElemOf (typeRep :: TypeRep t)) =<< toTupleToken a b
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
module Functions.Image
|
||||
( Image(..)
|
||||
, ImageConversionSettings(..)
|
||||
, openImage
|
||||
, saveImage
|
||||
, convertImage
|
||||
) where
|
||||
|
||||
import Types (IsFunction(..), IsFunctionIO(..), Token)
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
|
||||
runFunction, runFunctionIO, runFunctionIO_)
|
||||
|
||||
import qualified Codec.Picture as CP
|
||||
import qualified Codec.Picture.STBIR as CPS
|
||||
|
||||
|
||||
newtype Image = ImageWrapper (CP.Image CP.PixelRGB8)
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Image where
|
||||
show = const "<image>"
|
||||
|
||||
data ImageConversionSettings = ResizeToWidth Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OpenImage = OpenImage deriving Show
|
||||
instance IsFunctionIO OpenImage FilePath Image where
|
||||
evalFunctionIO OpenImage s = do
|
||||
imageOrig <- CP.readImage s
|
||||
case imageOrig of
|
||||
Left e -> error ("unexpected error: " ++ e)
|
||||
Right image -> pure $ ImageWrapper $ CP.convertRGB8 image
|
||||
functionIOTouchesFilesystem OpenImage = False
|
||||
|
||||
openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image)
|
||||
openImage a = runFunctionIO OpenImage =<< toToken a
|
||||
|
||||
|
||||
data SaveImage = SaveImage deriving Show
|
||||
instance IsFunctionIO SaveImage (Image, FilePath) () where
|
||||
evalFunctionIO SaveImage (ImageWrapper image, s) =
|
||||
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
|
||||
functionIOTouchesFilesystem SaveImage = True
|
||||
|
||||
saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
|
||||
|
||||
|
||||
data ConvertImage = ConvertImage deriving Show
|
||||
instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where
|
||||
evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) =
|
||||
let sizeFactor :: Double
|
||||
sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
|
||||
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
|
||||
in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image
|
||||
|
||||
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
|
||||
convertImage a b = runFunction ConvertImage =<< toTupleToken a b
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
module Functions.Pandoc
|
||||
( runPandoc
|
||||
) where
|
||||
|
||||
import Types (IsFunction(..), Token)
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Text.Pandoc as P
|
||||
import qualified Text.Blaze.Html.Renderer.Text as B
|
||||
|
||||
|
||||
data RunPandoc = RunPandoc deriving Show
|
||||
instance IsFunction RunPandoc Text Text where
|
||||
evalFunction RunPandoc contents =
|
||||
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
|
||||
m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
|
||||
in case P.runPure m of
|
||||
Left e -> error ("unexpected pandoc error: " ++ show e)
|
||||
Right html -> TL.toStrict $ B.renderHtml html
|
||||
|
||||
runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text)
|
||||
runPandoc a = runFunction RunPandoc =<< toToken a
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
module Functions.Paths
|
||||
( joinPaths
|
||||
, fileComponents
|
||||
, hasExtension
|
||||
, listDirectory
|
||||
, isDirectory
|
||||
, makeDir
|
||||
, copyFile
|
||||
, copyTo
|
||||
) where
|
||||
|
||||
import Functions.Text (lowerString)
|
||||
import Functions.General (elemOf)
|
||||
import Types (IsFunction(..), IsFunctionIO(..), Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction,
|
||||
runFunctionIO, runFunctionIO_, untupleSndDepGenM)
|
||||
|
||||
import qualified System.Directory as SD
|
||||
|
||||
|
||||
data JoinPaths = JoinPaths deriving Show
|
||||
instance IsFunction JoinPaths (FilePath, FilePath) FilePath where
|
||||
evalFunction JoinPaths (s0, s1) = s0 ++ "/" ++ s1
|
||||
|
||||
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
|
||||
joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
|
||||
|
||||
|
||||
data FileComponents = FileComponents deriving Show
|
||||
instance IsFunction FileComponents FilePath (String, String) where
|
||||
evalFunction FileComponents s =
|
||||
let (lastRev, firstRev) = span (/= '.') $ reverse s
|
||||
(base, ext) = case firstRev of
|
||||
_ : firstRev' -> (reverse firstRev', reverse lastRev)
|
||||
[] -> (reverse lastRev, "")
|
||||
in (base, ext)
|
||||
|
||||
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
|
||||
fileComponents a = runFunction FileComponents =<< toToken a
|
||||
|
||||
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
|
||||
hasExtension exts filename = do
|
||||
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
|
||||
ext `elemOf` exts
|
||||
|
||||
|
||||
data ListDirectory = ListDirectory deriving Show
|
||||
instance IsFunctionIO ListDirectory FilePath [FilePath] where
|
||||
evalFunctionIO ListDirectory s =
|
||||
SD.listDirectory s
|
||||
functionIOTouchesFilesystem ListDirectory = False
|
||||
|
||||
listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath])
|
||||
listDirectory a = runFunctionIO ListDirectory =<< toToken a
|
||||
|
||||
|
||||
data IsDirectory = IsDirectory deriving Show
|
||||
instance IsFunctionIO IsDirectory FilePath Bool where
|
||||
evalFunctionIO IsDirectory s =
|
||||
SD.doesDirectoryExist s
|
||||
functionIOTouchesFilesystem IsDirectory = False
|
||||
|
||||
isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool)
|
||||
isDirectory a = runFunctionIO IsDirectory =<< toToken a
|
||||
|
||||
|
||||
data MakeDir = MakeDir deriving Show
|
||||
instance IsFunctionIO MakeDir FilePath () where
|
||||
evalFunctionIO MakeDir s =
|
||||
SD.createDirectory s
|
||||
functionIOTouchesFilesystem MakeDir = True
|
||||
|
||||
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
|
||||
makeDir a = runFunctionIO_ MakeDir =<< toToken a
|
||||
|
||||
|
||||
data CopyFile = CopyFile deriving Show
|
||||
instance IsFunctionIO CopyFile (FilePath, FilePath) () where
|
||||
evalFunctionIO CopyFile (source, target) =
|
||||
SD.copyFile source target
|
||||
functionIOTouchesFilesystem CopyFile = True
|
||||
|
||||
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b
|
||||
|
||||
copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
copyTo path targetDir = do
|
||||
pathToken <- toToken path
|
||||
copyFile pathToken =<< joinPaths targetDir pathToken
|
||||
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
module Functions.Template
|
||||
( Template(..)
|
||||
, makeTemplate
|
||||
, applyTemplate
|
||||
) where
|
||||
|
||||
import Types (IsFunction(..), Token)
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
data Template = TemplateParts Text Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
data MakeTemplate = MakeTemplate deriving Show
|
||||
instance IsFunction MakeTemplate (Text, Text) Template where
|
||||
evalFunction MakeTemplate (t, c) =
|
||||
let (beforeContent, after) = T.breakOn c t
|
||||
afterContent = T.drop (T.length c) after
|
||||
in TemplateParts beforeContent afterContent
|
||||
|
||||
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
|
||||
makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
|
||||
|
||||
|
||||
data ApplyTemplate = ApplyTemplate deriving Show
|
||||
instance IsFunction ApplyTemplate (Template, Text) Text where
|
||||
evalFunction ApplyTemplate (TemplateParts beforeContent afterContent, t) =
|
||||
T.concat [beforeContent, t, afterContent]
|
||||
|
||||
applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
|
||||
applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
module Functions.Text
|
||||
( concatStrings
|
||||
, concatTexts
|
||||
, lowerString
|
||||
, toText
|
||||
, readTextFile
|
||||
, saveTextFile
|
||||
) where
|
||||
|
||||
import Types (IsFunction(..), IsFunctionIO(..), Token)
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
|
||||
runFunction, runFunctionIO, runFunctionIO_)
|
||||
|
||||
import Data.Char (toLower)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
|
||||
data ConcatStrings = ConcatStrings deriving Show
|
||||
instance IsFunction ConcatStrings [String] String where
|
||||
evalFunction ConcatStrings = concat
|
||||
|
||||
concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
|
||||
concatStrings a = runFunction ConcatStrings =<< toToken a
|
||||
|
||||
|
||||
data ConcatTexts = ConcatTexts deriving Show
|
||||
instance IsFunction ConcatTexts [Text] Text where
|
||||
evalFunction ConcatTexts = T.concat
|
||||
|
||||
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
|
||||
concatTexts a = runFunction ConcatTexts =<< toToken a
|
||||
|
||||
|
||||
data LowerString = LowerString deriving Show
|
||||
instance IsFunction LowerString String String where
|
||||
evalFunction LowerString s = map toLower s
|
||||
|
||||
lowerString :: TokenableTo String a => a -> DepGenM (Token String)
|
||||
lowerString a = runFunction LowerString =<< toToken a
|
||||
|
||||
|
||||
data ToText = ToText deriving Show
|
||||
instance IsFunction ToText String Text where
|
||||
evalFunction ToText s = T.pack s
|
||||
|
||||
toText :: TokenableTo String a => a -> DepGenM (Token Text)
|
||||
toText a = runFunction ToText =<< toToken a
|
||||
|
||||
|
||||
data ReadTextFile = ReadTextFile deriving Show
|
||||
instance IsFunctionIO ReadTextFile FilePath Text where
|
||||
evalFunctionIO ReadTextFile s =
|
||||
T.readFile s
|
||||
functionIOTouchesFilesystem ReadTextFile = False
|
||||
|
||||
readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text)
|
||||
readTextFile a = runFunctionIO ReadTextFile =<< toToken a
|
||||
|
||||
|
||||
data SaveTextFile = SaveTextFile deriving Show
|
||||
instance IsFunctionIO SaveTextFile (Text, FilePath) () where
|
||||
evalFunctionIO SaveTextFile (t, s) =
|
||||
T.writeFile s t
|
||||
functionIOTouchesFilesystem SaveTextFile = True
|
||||
|
||||
saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b
|
||||
|
|
@ -1,24 +1,11 @@
|
|||
module SiteGenerator (generateSite) where
|
||||
|
||||
import Prelude hiding (String, FilePath)
|
||||
|
||||
import Types
|
||||
import Types (Token)
|
||||
import DependencyGenerator
|
||||
import Function
|
||||
import FunctionIO
|
||||
import Functions
|
||||
|
||||
import Control.Monad (forM_)
|
||||
|
||||
copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
copyTo path targetDir = do
|
||||
pathToken <- toToken path
|
||||
copyFile pathToken =<< joinPaths targetDir pathToken
|
||||
|
||||
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
|
||||
hasExtension exts filename = do
|
||||
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
|
||||
ext `elemOf` exts
|
||||
|
||||
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
|
||||
handleRecipeDir outputDir htmlTemplate indexName dir = do
|
||||
recipeDirOut <- joinPaths outputDir dir
|
||||
|
|
|
|||
|
|
@ -1,15 +1,11 @@
|
|||
module Types
|
||||
( module Types.Token
|
||||
, module Types.Values
|
||||
, module Types.Value
|
||||
, module Types.Function
|
||||
, module Types.FunctionIO
|
||||
, module Types.Functions
|
||||
, Dependency
|
||||
) where
|
||||
|
||||
import Types.Token
|
||||
import Types.Values
|
||||
import Types.Value
|
||||
import Types.Function
|
||||
import Types.FunctionIO
|
||||
import Types.Functions
|
||||
import Types.Dependency (Dependency)
|
||||
|
|
|
|||
|
|
@ -11,8 +11,7 @@ module Types.Dependency
|
|||
|
||||
import Types.Token (Token(..))
|
||||
import Types.Value (Value)
|
||||
import Types.Function (IsFunction())
|
||||
import Types.FunctionIO (IsFunctionIO(..))
|
||||
import Types.Functions (IsFunction(), IsFunctionIO(..))
|
||||
|
||||
import Text.Printf (printf)
|
||||
import Data.Text (Text)
|
||||
|
|
|
|||
|
|
@ -1,9 +0,0 @@
|
|||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
module Types.Function
|
||||
( IsFunction(..)
|
||||
) where
|
||||
|
||||
import Types.Value (Valuable)
|
||||
|
||||
class (Show f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
|
||||
evalFunction :: f -> a -> b
|
||||
|
|
@ -1,10 +1,14 @@
|
|||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
module Types.FunctionIO
|
||||
( IsFunctionIO(..)
|
||||
module Types.Functions
|
||||
( IsFunction(..)
|
||||
, IsFunctionIO(..)
|
||||
) where
|
||||
|
||||
import Types.Value (Valuable)
|
||||
|
||||
class (Show f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
|
||||
evalFunction :: f -> a -> b
|
||||
|
||||
class (Show f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
|
||||
evalFunctionIO :: f -> a -> IO b
|
||||
functionIOTouchesFilesystem :: f -> Bool
|
||||
|
|
@ -1,117 +1,47 @@
|
|||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
module Types.Value
|
||||
( Value(..)
|
||||
, Valuable(..)
|
||||
, WitnessFor(..)
|
||||
) where
|
||||
|
||||
import Prelude hiding (String)
|
||||
import Data.Dynamic
|
||||
|
||||
import Types.Values
|
||||
data Value = Value { valueDynamic :: Dynamic
|
||||
, valueShow :: String
|
||||
}
|
||||
|
||||
import Data.Text (Text)
|
||||
instance Show Value where
|
||||
show = valueShow
|
||||
|
||||
-- Note: We use a wrapper for the String type in order to be able to define the
|
||||
-- general Valuable [a] instance further down. Otherwise it would conflict with
|
||||
-- our Valuable String instance, since the non-wrapped String type is just an
|
||||
-- alias for [Char].
|
||||
data Value = String String
|
||||
| Text Text
|
||||
| Bool Bool
|
||||
| Image Image
|
||||
| ImageConversionSettings ImageConversionSettings
|
||||
| Template Template
|
||||
| Empty
|
||||
| Tuple (Value, Value)
|
||||
| List [Value]
|
||||
deriving (Show)
|
||||
|
||||
class Valuable a where
|
||||
class Typeable a => Valuable a where
|
||||
toValue :: a -> Value
|
||||
fromValue :: Value -> a
|
||||
|
||||
instance Valuable String where
|
||||
toValue = String
|
||||
fromValue = \case
|
||||
String a -> a
|
||||
_ -> error "unexpected"
|
||||
toValueOnce :: (Typeable a, Show a) => a -> Value
|
||||
toValueOnce x = Value { valueDynamic = toDyn x
|
||||
, valueShow = show x
|
||||
}
|
||||
|
||||
instance Valuable Text where
|
||||
toValue = Text
|
||||
fromValue = \case
|
||||
Text a -> a
|
||||
_ -> error "unexpected"
|
||||
fromValueOnce :: Typeable a => Value -> a
|
||||
fromValueOnce = flip fromDyn (error "unexpected") . valueDynamic
|
||||
|
||||
instance Valuable Bool where
|
||||
toValue = Bool
|
||||
fromValue = \case
|
||||
Bool a -> a
|
||||
_ -> error "unexpected"
|
||||
instance Valuable Value where
|
||||
toValue = id
|
||||
fromValue = id
|
||||
|
||||
instance Valuable Image where
|
||||
toValue = Image
|
||||
fromValue = \case
|
||||
Image a -> a
|
||||
_ -> error "unexpected"
|
||||
instance {-# OVERLAPPABLE #-} Valuable String where
|
||||
toValue = toValueOnce
|
||||
fromValue = fromValueOnce
|
||||
|
||||
instance Valuable ImageConversionSettings where
|
||||
toValue = ImageConversionSettings
|
||||
fromValue = \case
|
||||
ImageConversionSettings a -> a
|
||||
_ -> error "unexpected"
|
||||
instance {-# OVERLAPPABLE #-} Valuable a => Valuable [a] where
|
||||
toValue = toValueOnce . map toValue
|
||||
fromValue = map fromValue . fromValueOnce
|
||||
|
||||
instance Valuable Template where
|
||||
toValue = Template
|
||||
fromValue = \case
|
||||
Template a -> a
|
||||
_ -> error "unexpected"
|
||||
instance {-# OVERLAPPABLE #-} (Valuable a, Valuable b) => Valuable (a, b) where
|
||||
toValue (a, b) = toValueOnce (toValue a, toValue b)
|
||||
fromValue v = let (va, vb) = fromValueOnce v
|
||||
in (fromValue va, fromValue vb)
|
||||
|
||||
instance Valuable () where
|
||||
toValue () = Empty
|
||||
fromValue = \case
|
||||
Empty -> ()
|
||||
_ -> error "unexpected"
|
||||
|
||||
instance (Valuable a, Valuable b) => Valuable (a, b) where
|
||||
toValue (a, b) = Tuple (toValue a, toValue b)
|
||||
fromValue = \case
|
||||
Tuple (va, vb) -> (fromValue va, fromValue vb)
|
||||
_ -> error "unexpected"
|
||||
|
||||
instance Valuable a => Valuable [a] where
|
||||
toValue = List . map toValue
|
||||
fromValue = \case
|
||||
List a -> map fromValue a
|
||||
_ -> error "unexpected"
|
||||
|
||||
|
||||
class Show w => WitnessFor w t | w -> t, t -> w where
|
||||
witnessValue :: w
|
||||
|
||||
data StringType = StringType deriving Show
|
||||
instance WitnessFor StringType String where witnessValue = StringType
|
||||
|
||||
data TextType = TextType deriving Show
|
||||
instance WitnessFor TextType Text where witnessValue = TextType
|
||||
|
||||
data BoolType = BoolType deriving Show
|
||||
instance WitnessFor BoolType Bool where witnessValue = BoolType
|
||||
|
||||
data ImageType = ImageType deriving Show
|
||||
instance WitnessFor ImageType Image where witnessValue = ImageType
|
||||
|
||||
data ImageConversionSettingsType = ImageConversionSettingsType deriving Show
|
||||
instance WitnessFor ImageConversionSettingsType ImageConversionSettings where witnessValue = ImageConversionSettingsType
|
||||
|
||||
data TemplateType = TemplateType deriving Show
|
||||
instance WitnessFor TemplateType Template where witnessValue = TemplateType
|
||||
|
||||
data EmptyType = EmptyType deriving Show
|
||||
instance WitnessFor EmptyType () where witnessValue = EmptyType
|
||||
|
||||
data TupleType ta tb = TupleType ta tb deriving Show
|
||||
instance (WitnessFor ta a, WitnessFor tb b) => WitnessFor (TupleType ta tb) (a, b) where witnessValue = TupleType witnessValue witnessValue
|
||||
|
||||
data ListType t = ListType t deriving Show
|
||||
instance WitnessFor t a => WitnessFor (ListType t) [a] where witnessValue = ListType witnessValue
|
||||
instance {-# OVERLAPPABLE #-} (Typeable a, Show a) => Valuable a where
|
||||
toValue = toValueOnce
|
||||
fromValue = fromValueOnce
|
||||
|
|
|
|||
|
|
@ -1,37 +0,0 @@
|
|||
module Types.Values
|
||||
( String(..)
|
||||
, FilePath
|
||||
, Image(..)
|
||||
, ImageConversionSettings(..)
|
||||
, Template(..)
|
||||
) where
|
||||
|
||||
import Prelude hiding (String, FilePath)
|
||||
import qualified Prelude
|
||||
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Codec.Picture as CP
|
||||
|
||||
newtype String = StringWrapper { unStringWrapper :: Prelude.String }
|
||||
deriving (Eq)
|
||||
|
||||
instance Show String where
|
||||
show (StringWrapper s) = show s
|
||||
|
||||
type FilePath = String
|
||||
|
||||
instance IsString String where
|
||||
fromString = StringWrapper
|
||||
|
||||
newtype Image = ImageWrapper (CP.Image CP.PixelRGB8)
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Image where
|
||||
show = const "Image"
|
||||
|
||||
data ImageConversionSettings = ResizeToWidth Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Template = TemplateParts Text Text
|
||||
deriving (Eq, Show)
|
||||
Loading…
Reference in New Issue