diff --git a/byg/byg.cabal b/byg/byg.cabal index badc75a..f044e5e 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -51,5 +51,4 @@ executable byg build-depends: base >=4.14 && <4.20 , text - , template-haskell , byg diff --git a/byg/src/Function.hs b/byg/src/Function.hs index 9427631..59b6b9c 100644 --- a/byg/src/Function.hs +++ b/byg/src/Function.hs @@ -29,10 +29,9 @@ 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 -import Language.Haskell.TH.Syntax (Lift) -data ConcatStrings = ConcatStrings deriving (Show, Lift) +data ConcatStrings = ConcatStrings deriving Show instance IsFunction ConcatStrings [String] String where evalFunction ConcatStrings = StringWrapper . concatMap unStringWrapper @@ -40,7 +39,7 @@ concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String) concatStrings a = runFunction ConcatStrings =<< toToken a -data ConcatTexts = ConcatTexts deriving (Show, Lift) +data ConcatTexts = ConcatTexts deriving Show instance IsFunction ConcatTexts [Text] Text where evalFunction ConcatTexts = T.concat @@ -48,7 +47,7 @@ concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text) concatTexts a = runFunction ConcatTexts =<< toToken a -data JoinPaths = JoinPaths deriving (Show, Lift) +data JoinPaths = JoinPaths deriving Show instance IsFunction JoinPaths (FilePath, FilePath) FilePath where evalFunction JoinPaths (StringWrapper s0, StringWrapper s1) = StringWrapper (s0 ++ "/" ++ s1) @@ -56,7 +55,7 @@ joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGe joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b -data FileComponents = FileComponents deriving (Show, Lift) +data FileComponents = FileComponents deriving Show instance IsFunction FileComponents FilePath (String, String) where evalFunction FileComponents (StringWrapper s) = let (lastRev, firstRev) = span (/= '.') $ reverse s @@ -69,7 +68,7 @@ fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String) fileComponents a = runFunction FileComponents =<< toToken a -data LowerString = LowerString deriving (Show, Lift) +data LowerString = LowerString deriving Show instance IsFunction LowerString String String where evalFunction LowerString (StringWrapper s) = StringWrapper (map toLower s) @@ -79,15 +78,14 @@ lowerString a = runFunction LowerString =<< toToken a data ElemOf a where ElemOf :: WitnessFor w a => w -> ElemOf a deriving instance Show (ElemOf a) -deriving instance Lift (ElemOf a) -instance (Show a, Lift a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where +instance (Show a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where evalFunction (ElemOf _) (y, ys) = y `elem` ys -elemOf :: forall t w a b. (Show t, Lift t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, WitnessFor w t) => a -> b -> DepGenM (Token Bool) +elemOf :: forall t w a b. (Show t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, WitnessFor w t) => a -> b -> DepGenM (Token Bool) elemOf a b = runFunction (ElemOf (witnessValue :: w)) =<< toTupleToken a b -data MakeTemplate = MakeTemplate deriving (Show, Lift) +data MakeTemplate = MakeTemplate deriving Show instance IsFunction MakeTemplate (Text, Text) Template where evalFunction MakeTemplate (t, c) = let (beforeContent, after) = T.breakOn c t @@ -98,7 +96,7 @@ makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (T makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b -data ApplyTemplate = ApplyTemplate deriving (Show, Lift) +data ApplyTemplate = ApplyTemplate deriving Show instance IsFunction ApplyTemplate (Template, Text) Text where evalFunction ApplyTemplate (TemplateParts beforeContent afterContent, t) = T.concat [beforeContent, t, afterContent] @@ -107,7 +105,7 @@ applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGe applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b -data ToText = ToText deriving (Show, Lift) +data ToText = ToText deriving Show instance IsFunction ToText String Text where evalFunction ToText (StringWrapper s) = T.pack s @@ -115,7 +113,7 @@ toText :: TokenableTo String a => a -> DepGenM (Token Text) toText a = runFunction ToText =<< toToken a -data ConvertImage = ConvertImage deriving (Show, Lift) +data ConvertImage = ConvertImage deriving Show instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) = let sizeFactor :: Double @@ -127,7 +125,7 @@ convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => convertImage a b = runFunction ConvertImage =<< toTupleToken a b -data RunPandoc = RunPandoc deriving (Show, Lift) +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 ] } diff --git a/byg/src/FunctionIO.hs b/byg/src/FunctionIO.hs index 5c3ebe9..28bb4df 100644 --- a/byg/src/FunctionIO.hs +++ b/byg/src/FunctionIO.hs @@ -20,10 +20,9 @@ import Data.Text (Text) import qualified Data.Text.IO as T import qualified Codec.Picture as CP import qualified System.Directory as SD -import Language.Haskell.TH.Syntax (Lift) -data ListDirectory = ListDirectory deriving (Show, Lift) +data ListDirectory = ListDirectory deriving Show instance IsFunctionIO ListDirectory FilePath [FilePath] where evalFunctionIO ListDirectory (StringWrapper s) = map StringWrapper <$> SD.listDirectory s @@ -33,7 +32,7 @@ listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath]) listDirectory a = runFunctionIO ListDirectory =<< toToken a -data IsDirectory = IsDirectory deriving (Show, Lift) +data IsDirectory = IsDirectory deriving Show instance IsFunctionIO IsDirectory FilePath Bool where evalFunctionIO IsDirectory (StringWrapper s) = SD.doesDirectoryExist s @@ -43,7 +42,7 @@ isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool) isDirectory a = runFunctionIO IsDirectory =<< toToken a -data ReadTextFile = ReadTextFile deriving (Show, Lift) +data ReadTextFile = ReadTextFile deriving Show instance IsFunctionIO ReadTextFile FilePath Text where evalFunctionIO ReadTextFile (StringWrapper s) = T.readFile s @@ -53,7 +52,7 @@ readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text) readTextFile a = runFunctionIO ReadTextFile =<< toToken a -data OpenImage = OpenImage deriving (Show, Lift) +data OpenImage = OpenImage deriving Show instance IsFunctionIO OpenImage FilePath Image where evalFunctionIO OpenImage (StringWrapper s) = do imageOrig <- CP.readImage s @@ -66,7 +65,7 @@ openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image) openImage a = runFunctionIO OpenImage =<< toToken a -data SaveImage = SaveImage deriving (Show, Lift) +data SaveImage = SaveImage deriving Show instance IsFunctionIO SaveImage (Image, FilePath) () where evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) = CP.saveJpgImage 90 s $ CP.ImageRGB8 image @@ -76,7 +75,7 @@ saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b -data SaveTextFile = SaveTextFile deriving (Show, Lift) +data SaveTextFile = SaveTextFile deriving Show instance IsFunctionIO SaveTextFile (Text, FilePath) () where evalFunctionIO SaveTextFile (t, StringWrapper s) = T.writeFile s t @@ -86,7 +85,7 @@ saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGen saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b -data CopyFile = CopyFile deriving (Show, Lift) +data CopyFile = CopyFile deriving Show instance IsFunctionIO CopyFile (FilePath, FilePath) () where evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) = SD.copyFile source target @@ -96,7 +95,7 @@ copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGen copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b -data MakeDir = MakeDir deriving (Show, Lift) +data MakeDir = MakeDir deriving Show instance IsFunctionIO MakeDir FilePath () where evalFunctionIO MakeDir (StringWrapper s) = SD.createDirectory s diff --git a/byg/src/Main.hs b/byg/src/Main.hs index adfa47e..e0e6d18 100644 --- a/byg/src/Main.hs +++ b/byg/src/Main.hs @@ -1,28 +1,17 @@ {-# LANGUAGE TemplateHaskell #-} module Main where -import DependencyGenerator (evalDepGenM) -import SiteGenerator (generateSite) import qualified Precomputer import System.Environment (getArgs) -import Data.Text (Text) -import qualified Data.Text.IO as T -import Language.Haskell.TH.Syntax - -formatDependencyTrees :: Text -formatDependencyTrees = $$(Precomputer.formatDependencyTrees $(lift (evalDepGenM generateSite))) - -runDeps :: IO () -runDeps = $$(Precomputer.runDeps $(lift (evalDepGenM generateSite))) main :: IO () main = do args <- getArgs case args of ["run"] -> - runDeps + $$(Precomputer.runDeps) ["tree"] -> - T.putStr formatDependencyTrees + $$(Precomputer.formatDependencyTrees) _ -> error "unexpected arguments" diff --git a/byg/src/Precomputer.hs b/byg/src/Precomputer.hs index 74afe55..b35eae5 100644 --- a/byg/src/Precomputer.hs +++ b/byg/src/Precomputer.hs @@ -4,15 +4,16 @@ module Precomputer , formatDependencyTrees ) where -import Types.Dependency (Dependency) import qualified DependencyRunner as DR import qualified Types.Dependency as D +import SiteGenerator (generateSite) +import DependencyGenerator (evalDepGenM) -import Data.Text (Text) +import qualified Data.Text.IO as T import Language.Haskell.TH.Syntax -runDeps :: [Dependency] -> Code Q (IO ()) -runDeps deps = [|| DR.runDepRunMIO (DR.runDeps deps) ||] +runDeps :: Code Q (IO ()) +runDeps = [|| DR.runDepRunMIO (DR.runDeps (evalDepGenM generateSite)) ||] -formatDependencyTrees :: [Dependency] -> Code Q Text -formatDependencyTrees deps = [|| D.formatDependencyTrees deps ||] +formatDependencyTrees :: Code Q (IO ()) +formatDependencyTrees = [|| T.putStr (D.formatDependencyTrees (evalDepGenM generateSite)) ||] diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index c4b293e..b9ad474 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -17,7 +17,6 @@ import Types.FunctionIO (IsFunctionIO(..)) import Text.Printf (printf) import Data.Text (Text) import qualified Data.Text as T -import Language.Haskell.TH.Syntax (Lift) data Action where Function :: IsFunction f a b => f -> Action @@ -31,17 +30,16 @@ data Action where MapComp :: [Dependency] -> UToken -> UToken -> Action deriving instance Show Action -deriving instance Lift Action data UToken = UToken Int | UTupleToken UToken UToken | UZipToken UToken UToken | UListToken [UToken] | UNoToken - deriving (Show, Lift) + deriving (Show) data Dependency = Dependency UToken Action UToken - deriving (Show, Lift) + deriving (Show) makeDependency :: Token a -> Action -> Token b -> Dependency makeDependency a action b = Dependency (makeUToken a) action (makeUToken b) diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs index 4abd4f6..ca41d0c 100644 --- a/byg/src/Types/Function.hs +++ b/byg/src/Types/Function.hs @@ -5,7 +5,5 @@ module Types.Function import Types.Value (Valuable) -import Language.Haskell.TH.Syntax (Lift) - -class (Show f, Lift f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where +class (Show f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where evalFunction :: f -> a -> b diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs index 13c6947..9ba90be 100644 --- a/byg/src/Types/FunctionIO.hs +++ b/byg/src/Types/FunctionIO.hs @@ -5,9 +5,6 @@ module Types.FunctionIO import Types.Value (Valuable) -import Language.Haskell.TH.Syntax (Lift) - - -class (Show f, Lift f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where +class (Show f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where evalFunctionIO :: f -> a -> IO b functionIOTouchesFilesystem :: f -> Bool diff --git a/byg/src/Types/Token.hs b/byg/src/Types/Token.hs index cfd5476..c6b5fb5 100644 --- a/byg/src/Types/Token.hs +++ b/byg/src/Types/Token.hs @@ -3,8 +3,6 @@ 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) @@ -13,4 +11,3 @@ data Token a where NoToken :: Token () deriving instance Show (Token a) -deriving instance Lift (Token a) diff --git a/byg/src/Types/Value.hs b/byg/src/Types/Value.hs index ab38ed9..baa916f 100644 --- a/byg/src/Types/Value.hs +++ b/byg/src/Types/Value.hs @@ -11,16 +11,11 @@ import Prelude hiding (String) import Types.Values import Data.Text (Text) -import Language.Haskell.TH.Syntax (Lift) -- 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]. --- --- Also note that the Image type does not actually implement Lift, so you --- shouldn't use it with Inject. The better approach would be to split the --- Value type into a compile-time version and a runtime version. data Value = String String | Text Text | Bool Bool @@ -30,7 +25,7 @@ data Value = String String | Empty | Tuple (Value, Value) | List [Value] - deriving (Eq, Show, Lift) + deriving (Eq, Show) class Valuable a where toValue :: a -> Value @@ -91,32 +86,32 @@ instance Valuable a => Valuable [a] where _ -> error "unexpected" -class (Show w, Lift w) => WitnessFor w t | w -> t, t -> w where +class Show w => WitnessFor w t | w -> t, t -> w where witnessValue :: w -data StringType = StringType deriving (Show, Lift) +data StringType = StringType deriving Show instance WitnessFor StringType String where witnessValue = StringType -data TextType = TextType deriving (Show, Lift) +data TextType = TextType deriving Show instance WitnessFor TextType Text where witnessValue = TextType -data BoolType = BoolType deriving (Show, Lift) +data BoolType = BoolType deriving Show instance WitnessFor BoolType Bool where witnessValue = BoolType -data ImageType = ImageType deriving (Show, Lift) +data ImageType = ImageType deriving Show instance WitnessFor ImageType Image where witnessValue = ImageType -data ImageConversionSettingsType = ImageConversionSettingsType deriving (Show, Lift) +data ImageConversionSettingsType = ImageConversionSettingsType deriving Show instance WitnessFor ImageConversionSettingsType ImageConversionSettings where witnessValue = ImageConversionSettingsType -data TemplateType = TemplateType deriving (Show, Lift) +data TemplateType = TemplateType deriving Show instance WitnessFor TemplateType Template where witnessValue = TemplateType -data EmptyType = EmptyType deriving (Show, Lift) +data EmptyType = EmptyType deriving Show instance WitnessFor EmptyType () where witnessValue = EmptyType -data TupleType ta tb = TupleType ta tb deriving (Show, Lift) +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, Lift) +data ListType t = ListType t deriving Show instance WitnessFor t a => WitnessFor (ListType t) [a] where witnessValue = ListType witnessValue diff --git a/byg/src/Types/Values.hs b/byg/src/Types/Values.hs index 00c2214..e52e3bb 100644 --- a/byg/src/Types/Values.hs +++ b/byg/src/Types/Values.hs @@ -12,10 +12,9 @@ import qualified Prelude import Data.String (IsString(..)) import Data.Text (Text) import qualified Codec.Picture as CP -import Language.Haskell.TH.Syntax (Lift(..)) newtype String = StringWrapper { unStringWrapper :: Prelude.String } - deriving (Eq, Lift) + deriving (Eq) instance Show String where show (StringWrapper s) = show s @@ -31,11 +30,8 @@ newtype Image = ImageWrapper (CP.Image CP.PixelRGB8) instance Show Image where show = const "Image" -instance Lift Image where - liftTyped _ = error "cannot lift images" - data ImageConversionSettings = ResizeToWidth Int - deriving (Eq, Show, Lift) + deriving (Eq, Show) data Template = TemplateParts Text Text - deriving (Eq, Show, Lift) + deriving (Eq, Show)