Don't lift types

Not needed since we only care about the final IO () result.

byg/byg.cabal

@@ -51,5 +51,4 @@ executable byg
     build-depends:
         base >=4.14 && <4.20
       , text
-      , template-haskell
       , byg

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, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
-instance (Show a, Lift 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 ] }

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

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"

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 :: Code Q (IO ())
-runDeps deps = [|| DR.runDepRunMIO (DR.runDeps deps) ||]
+runDeps = [|| DR.runDepRunMIO (DR.runDeps (evalDepGenM generateSite)) ||]
 
-formatDependencyTrees :: [Dependency] -> Code Q Text
+formatDependencyTrees :: Code Q (IO ())
-formatDependencyTrees deps = [|| D.formatDependencyTrees deps ||]
+formatDependencyTrees = [|| T.putStr (D.formatDependencyTrees (evalDepGenM generateSite)) ||]

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)

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, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
-
-class (Show f, Lift f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
   evalFunction :: f -> a -> 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, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
-
-
-class (Show f, Lift f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
   evalFunctionIO :: f -> a -> IO b
   functionIOTouchesFilesystem :: f -> Bool

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)

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

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)