Use inline functions everywhere except for IO
This commit is contained in:
parent
1da32745a2
commit
740cb67d66
|
@ -8,7 +8,7 @@ module DependencyGenerator
|
||||||
, evalDepGenM
|
, evalDepGenM
|
||||||
, inject
|
, inject
|
||||||
, onToken
|
, onToken
|
||||||
, runFunction
|
, onTupleToken
|
||||||
, runFunctionIO
|
, runFunctionIO
|
||||||
, runFunctionIO_
|
, runFunctionIO_
|
||||||
, mapDepGenM
|
, mapDepGenM
|
||||||
|
@ -27,7 +27,7 @@ module DependencyGenerator
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types.Token (Token(..))
|
import Types.Token (Token(..))
|
||||||
import Types.Functions (IsFunction(), IsFunctionIO(..))
|
import Types.Functions (IsFunctionIO(..))
|
||||||
import Types.Dependency (Action(..), F(..), Dependency, makeDependency)
|
import Types.Dependency (Action(..), F(..), Dependency, makeDependency)
|
||||||
|
|
||||||
import Type.Reflection (Typeable, TypeRep, typeRep)
|
import Type.Reflection (Typeable, TypeRep, typeRep)
|
||||||
|
@ -72,10 +72,12 @@ inject x = genDependency (makeDependency NoToken (Inject x))
|
||||||
onToken :: (TokenableTo a t, Show a, Typeable a, Show b, Typeable b) => (a -> b) -> t -> DepGenM (Token b)
|
onToken :: (TokenableTo a t, Show a, Typeable a, Show b, Typeable b) => (a -> b) -> t -> DepGenM (Token b)
|
||||||
onToken f input = do
|
onToken f input = do
|
||||||
input' <- toToken input
|
input' <- toToken input
|
||||||
genDependency (makeDependency input' (InlineFunction (F f)))
|
genDependency (makeDependency input' (Function (F f)))
|
||||||
|
|
||||||
runFunction :: IsFunction f a b => f -> Token a -> DepGenM (Token b)
|
onTupleToken :: (TokenableTo a t1, Show a, Typeable a, TokenableTo b t2, Show b, Typeable b, Show r, Typeable r) => (a -> b -> r) -> t1 -> t2 -> DepGenM (Token r)
|
||||||
runFunction f input = genDependency (makeDependency input (Function f))
|
onTupleToken f input1 input2 = do
|
||||||
|
tup <- toTupleToken input1 input2
|
||||||
|
genDependency (makeDependency tup (Function (F (uncurry f))))
|
||||||
|
|
||||||
runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b)
|
runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b)
|
||||||
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
|
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
|
||||||
|
|
|
@ -5,7 +5,7 @@ module DependencyRunner
|
||||||
, runDepRunMIO
|
, runDepRunMIO
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types (evalFunction, evalFunctionIO)
|
import Types (evalFunctionIO)
|
||||||
import Types.Value
|
import Types.Value
|
||||||
import Types.Token
|
import Types.Token
|
||||||
import Types.Dependency
|
import Types.Dependency
|
||||||
|
@ -94,9 +94,7 @@ putTokenValue t e = case t of
|
||||||
|
|
||||||
runAction :: forall a b. Action a b -> Value -> DepRunM Value
|
runAction :: forall a b. Action a b -> Value -> DepRunM Value
|
||||||
runAction action input = case action of
|
runAction action input = case action of
|
||||||
Function f ->
|
Function (F f) ->
|
||||||
calc (evalFunction f)
|
|
||||||
InlineFunction (F f) ->
|
|
||||||
calc f
|
calc f
|
||||||
FunctionIO f ->
|
FunctionIO f ->
|
||||||
calcM (liftIO . evalFunctionIO f)
|
calcM (liftIO . evalFunctionIO f)
|
||||||
|
|
|
@ -1,18 +1,9 @@
|
||||||
{-# LANGUAGE GADTs #-}
|
|
||||||
module Functions.General
|
module Functions.General
|
||||||
( elemOf
|
( elemOf
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types (IsFunction(..), Token)
|
import Types (Token)
|
||||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
|
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
|
||||||
|
|
||||||
import Type.Reflection (Typeable, TypeRep, typeRep)
|
elemOf :: (Eq t, TokenableTo t a, TokenableTo [t] b) => a -> b -> DepGenM (Token Bool)
|
||||||
|
elemOf = onTupleToken elem
|
||||||
|
|
||||||
data ElemOf a where ElemOf :: TypeRep a -> ElemOf a
|
|
||||||
deriving instance Show (ElemOf a)
|
|
||||||
instance (Show a, Typeable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
|
|
||||||
evalFunction (ElemOf _) (y, ys) = y `elem` ys
|
|
||||||
|
|
||||||
elemOf :: forall t a b. (Show t, Typeable 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
|
|
||||||
|
|
|
@ -6,9 +6,9 @@ module Functions.Image
|
||||||
, convertImage
|
, convertImage
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types (IsFunction(..), IsFunctionIO(..), Token)
|
import Types (IsFunctionIO(..), Token)
|
||||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
|
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken, toTupleToken,
|
||||||
runFunction, runFunctionIO, runFunctionIO_)
|
runFunctionIO, runFunctionIO_)
|
||||||
|
|
||||||
import qualified Codec.Picture as CP
|
import qualified Codec.Picture as CP
|
||||||
import qualified Codec.Picture.STBIR as CPS
|
import qualified Codec.Picture.STBIR as CPS
|
||||||
|
@ -46,13 +46,9 @@ saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM
|
||||||
saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
|
saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
|
||||||
|
|
||||||
|
|
||||||
data ConvertImage = ConvertImage deriving Show
|
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
|
||||||
instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where
|
convertImage = onTupleToken $ \(ImageWrapper image) (ResizeToWidth widthResized) ->
|
||||||
evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) =
|
|
||||||
let sizeFactor :: Double
|
let sizeFactor :: Double
|
||||||
sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
|
sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
|
||||||
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
|
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
|
||||||
in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image
|
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
|
|
||||||
|
|
|
@ -11,33 +11,23 @@ module Functions.Paths
|
||||||
|
|
||||||
import Functions.Text (lowerString)
|
import Functions.Text (lowerString)
|
||||||
import Functions.General (elemOf)
|
import Functions.General (elemOf)
|
||||||
import Types (IsFunction(..), IsFunctionIO(..), Token(..))
|
import Types (IsFunctionIO(..), Token(..))
|
||||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction,
|
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken, toTupleToken,
|
||||||
runFunctionIO, runFunctionIO_, untupleSndDepGenM)
|
runFunctionIO, runFunctionIO_, untupleSndDepGenM)
|
||||||
|
|
||||||
import qualified System.Directory as SD
|
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 :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
|
||||||
joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
|
joinPaths = onTupleToken $ \s0 s1 -> s0 ++ "/" ++ s1
|
||||||
|
|
||||||
|
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
|
||||||
data FileComponents = FileComponents deriving Show
|
fileComponents = onToken $ \s ->
|
||||||
instance IsFunction FileComponents FilePath (String, String) where
|
|
||||||
evalFunction FileComponents s =
|
|
||||||
let (lastRev, firstRev) = span (/= '.') $ reverse s
|
let (lastRev, firstRev) = span (/= '.') $ reverse s
|
||||||
(base, ext) = case firstRev of
|
(base, ext) = case firstRev of
|
||||||
_ : firstRev' -> (reverse firstRev', reverse lastRev)
|
_ : firstRev' -> (reverse firstRev', reverse lastRev)
|
||||||
[] -> (reverse lastRev, "")
|
[] -> (reverse lastRev, "")
|
||||||
in (base, ext)
|
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 :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
|
||||||
hasExtension exts filename = do
|
hasExtension exts filename = do
|
||||||
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
|
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
|
||||||
|
|
|
@ -4,8 +4,8 @@ module Functions.Template
|
||||||
, applyTemplate
|
, applyTemplate
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types (IsFunction(..), Token)
|
import Types (Token)
|
||||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
|
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
|
||||||
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -13,21 +13,12 @@ import qualified Data.Text as T
|
||||||
data Template = TemplateParts Text Text
|
data Template = TemplateParts Text Text
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data MakeTemplate = MakeTemplate deriving Show
|
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
|
||||||
instance IsFunction MakeTemplate (Text, Text) Template where
|
makeTemplate = onTupleToken $ \t c ->
|
||||||
evalFunction MakeTemplate (t, c) =
|
|
||||||
let (beforeContent, after) = T.breakOn c t
|
let (beforeContent, after) = T.breakOn c t
|
||||||
afterContent = T.drop (T.length c) after
|
afterContent = T.drop (T.length c) after
|
||||||
in TemplateParts beforeContent afterContent
|
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 :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
|
||||||
applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
|
applyTemplate = onTupleToken $ \(TemplateParts beforeContent afterContent) t ->
|
||||||
|
T.concat [beforeContent, t, afterContent]
|
||||||
|
|
|
@ -7,46 +7,26 @@ module Functions.Text
|
||||||
, saveTextFile
|
, saveTextFile
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types (IsFunction(..), IsFunctionIO(..), Token)
|
import Types (IsFunctionIO(..), Token)
|
||||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
|
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, toTupleToken,
|
||||||
runFunction, runFunctionIO, runFunctionIO_)
|
runFunctionIO, runFunctionIO_)
|
||||||
|
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO 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 :: TokenableTo [String] a => a -> DepGenM (Token String)
|
||||||
concatStrings a = runFunction ConcatStrings =<< toToken a
|
concatStrings = onToken concat
|
||||||
|
|
||||||
|
|
||||||
data ConcatTexts = ConcatTexts deriving Show
|
|
||||||
instance IsFunction ConcatTexts [Text] Text where
|
|
||||||
evalFunction ConcatTexts = T.concat
|
|
||||||
|
|
||||||
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
|
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
|
||||||
concatTexts a = runFunction ConcatTexts =<< toToken a
|
concatTexts = onToken T.concat
|
||||||
|
|
||||||
|
|
||||||
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 :: TokenableTo String a => a -> DepGenM (Token String)
|
||||||
lowerString a = runFunction LowerString =<< toToken a
|
lowerString = onToken (map toLower)
|
||||||
|
|
||||||
|
|
||||||
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 :: TokenableTo String a => a -> DepGenM (Token Text)
|
||||||
toText a = runFunction ToText =<< toToken a
|
toText = onToken T.pack
|
||||||
|
|
||||||
|
|
||||||
data ReadTextFile = ReadTextFile deriving Show
|
data ReadTextFile = ReadTextFile deriving Show
|
||||||
|
|
|
@ -11,7 +11,7 @@ module Types.Dependency
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types.Token (Token(..))
|
import Types.Token (Token(..))
|
||||||
import Types.Functions (IsFunction(), IsFunctionIO(..))
|
import Types.Functions (IsFunctionIO(..))
|
||||||
|
|
||||||
import Type.Reflection (Typeable, TypeRep, typeRep)
|
import Type.Reflection (Typeable, TypeRep, typeRep)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
@ -19,8 +19,7 @@ import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
data Action a b where
|
data Action a b where
|
||||||
Function :: IsFunction f a b => f -> Action a b
|
Function :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
|
||||||
InlineFunction :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
|
|
||||||
FunctionIO :: IsFunctionIO f a b => f -> Action a b
|
FunctionIO :: IsFunctionIO f a b => f -> Action a b
|
||||||
Inject :: (Typeable a, Show a) => a -> Action () a
|
Inject :: (Typeable a, Show a) => a -> Action () a
|
||||||
FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a]
|
FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a]
|
||||||
|
@ -53,7 +52,6 @@ actionTargetType _ = typeRep
|
||||||
actionTouchesFilesystem :: Action a b -> Bool
|
actionTouchesFilesystem :: Action a b -> Bool
|
||||||
actionTouchesFilesystem = \case
|
actionTouchesFilesystem = \case
|
||||||
Function _ -> False
|
Function _ -> False
|
||||||
InlineFunction _ -> False
|
|
||||||
FunctionIO f -> functionIOTouchesFilesystem f
|
FunctionIO f -> functionIOTouchesFilesystem f
|
||||||
Inject _ -> False
|
Inject _ -> False
|
||||||
FilterComp -> False
|
FilterComp -> False
|
||||||
|
|
|
@ -1,14 +1,10 @@
|
||||||
{-# LANGUAGE FunctionalDependencies #-}
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
module Types.Functions
|
module Types.Functions
|
||||||
( IsFunction(..)
|
( IsFunctionIO(..)
|
||||||
, IsFunctionIO(..)
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Type.Reflection (Typeable)
|
import Type.Reflection (Typeable)
|
||||||
|
|
||||||
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunction f a b | f -> a b where
|
|
||||||
evalFunction :: f -> a -> b
|
|
||||||
|
|
||||||
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where
|
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where
|
||||||
evalFunctionIO :: f -> a -> IO b
|
evalFunctionIO :: f -> a -> IO b
|
||||||
functionIOTouchesFilesystem :: f -> Bool
|
functionIOTouchesFilesystem :: f -> Bool
|
||||||
|
|
Loading…
Reference in New Issue