{-# LANGUAGE CPP, ConstraintKinds, RankNTypes, GADTs #-}
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -Wno-unused-binds #-}
#else
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
#endif
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | A model of polymorphic tasks, where the value type depends on the key.
-- See the source for an example.
module Build.Task.Typed (Task, dependencies) where

#if __GLASGOW_HASKELL__ < 800
import Control.Applicative
#else
import Data.Functor.Const
#endif

-- | The @fetch@ callback whose result type depends on the type of the key.
type Fetch k f = forall a. k a -> f a

-- | A typed build task.
--
-- A side observation: we could also rewrite the type of `Task` into
--
-- type Task c k = forall f. c f => (forall a. k a -> f a) -> (forall a. k a -> Maybe (f a))
--
-- ...which looks like a morphism between natural transformations. I'll let
-- category theory enthusiasts explain what this strange creature is doing here.
type Task c k = forall f a. c f => Fetch k f -> k a -> Maybe (f a)

-- | A way to show the name of a key.
type ShowKey k = forall a. k a -> String

-- | Extract the names of dependencies.
dependencies :: ShowKey k -> Task Applicative k -> k a -> [String]
dependencies :: forall (k :: * -> *) a.
ShowKey k -> Task Applicative k -> k a -> [String]
dependencies ShowKey k
showKey Task Applicative k
task = [String]
-> (Const [String] a -> [String])
-> Maybe (Const [String] a)
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Const [String] a -> [String]
forall {k} a (b :: k). Const a b -> a
getConst (Maybe (Const [String] a) -> [String])
-> (k a -> Maybe (Const [String] a)) -> k a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fetch k (Const [String]) -> k a -> Maybe (Const [String] a)
Task Applicative k
task (\k a
k -> [String] -> Const [String] a
forall {k} a (b :: k). a -> Const a b
Const [k a -> String
ShowKey k
showKey k a
k])

----------------------------- GCC versison example -----------------------------
data Version = Version { Version -> Int
major :: Int, Version -> Int
minor :: Int }
    deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord)

data Key a where
    File       :: FilePath -> Key String
    GccVersion :: Key Version

newtype TaskT c k v = TaskT { forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
TaskT c k v -> forall (f :: * -> *). c f => Fetch k f -> f v
runT :: forall f. c f => Fetch k f -> f v }

type TasksT c k = forall a. k a -> Maybe (TaskT c k a)

example :: TasksT Monad Key
example :: TasksT Monad Key
example (File String
"release.txt") = TaskT Monad Key a -> Maybe (TaskT Monad Key a)
forall a. a -> Maybe a
Just (TaskT Monad Key a -> Maybe (TaskT Monad Key a))
-> TaskT Monad Key a -> Maybe (TaskT Monad Key a)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *). Monad f => Fetch Key f -> f a)
-> TaskT Monad Key a
forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
(forall (f :: * -> *). c f => Fetch k f -> f v) -> TaskT c k v
TaskT ((forall (f :: * -> *). Monad f => Fetch Key f -> f a)
 -> TaskT Monad Key a)
-> (forall (f :: * -> *). Monad f => Fetch Key f -> f a)
-> TaskT Monad Key a
forall a b. (a -> b) -> a -> b
$ \Fetch Key f
fetch -> do
    String
readme  <- Key String -> f String
Fetch Key f
fetch (String -> Key String
File String
"README")
    String
license <- Key String -> f String
Fetch Key f
fetch (String -> Key String
File String
"LICENSE")
    a -> f a
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
readme String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
license)
example (File String
"main.o") = TaskT Monad Key a -> Maybe (TaskT Monad Key a)
forall a. a -> Maybe a
Just (TaskT Monad Key a -> Maybe (TaskT Monad Key a))
-> TaskT Monad Key a -> Maybe (TaskT Monad Key a)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *). Monad f => Fetch Key f -> f a)
-> TaskT Monad Key a
forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
(forall (f :: * -> *). c f => Fetch k f -> f v) -> TaskT c k v
TaskT ((forall (f :: * -> *). Monad f => Fetch Key f -> f a)
 -> TaskT Monad Key a)
-> (forall (f :: * -> *). Monad f => Fetch Key f -> f a)
-> TaskT Monad Key a
forall a b. (a -> b) -> a -> b
$ \Fetch Key f
fetch -> do
    let source :: String
source = String
"main.c"
    Version
version <- Key Version -> f Version
Fetch Key f
fetch Key Version
GccVersion
    if Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int -> Version
Version Int
8 Int
0 then String -> f String
forall (f :: * -> *). String -> f String
compileNew String
source
                              else String -> f String
forall (f :: * -> *). String -> f String
compileOld String
source
example Key a
_ = Maybe (TaskT Monad Key a)
forall a. Maybe a
Nothing

compileNew :: String -> f String
compileNew :: forall (f :: * -> *). String -> f String
compileNew = String -> f String
forall a. HasCallStack => a
undefined

compileOld :: String -> f String
compileOld :: forall (f :: * -> *). String -> f String
compileOld = String -> f String
forall a. HasCallStack => a
undefined

------------------------------------ Example -----------------------------------
data KeyN a where
    Base       :: KeyN Int
    Number     :: KeyN Int
    SplitDigit :: KeyN (Int, Int)
    LastDigit  :: KeyN Int
    BaseDigits :: KeyN [Int]

-- | A build task for some simple typed numeric calculations. We can perform
-- static analysis of this task using the function 'dependencies'. For example:
--
-- @
-- dependencies showKey task Base       == []
-- dependencies showKey task SplitDigit == ["Number","Base"]
-- @
task :: Task Applicative KeyN
task :: Task Applicative KeyN
task Fetch KeyN f
fetch KeyN a
SplitDigit = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a -> Maybe (f a)) -> f a -> Maybe (f a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int -> a) -> f Int -> f (Int -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyN Int -> f Int
Fetch KeyN f
fetch KeyN Int
Number f (Int -> a) -> f Int -> f a
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyN Int -> f Int
Fetch KeyN f
fetch KeyN Int
Base
task Fetch KeyN f
fetch KeyN a
LastDigit  = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a -> Maybe (f a)) -> f a -> Maybe (f a)
forall a b. (a -> b) -> a -> b
$ (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> f (Int, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyN (Int, a) -> f (Int, a)
Fetch KeyN f
fetch KeyN (Int, a)
KeyN (Int, Int)
SplitDigit
task Fetch KeyN f
fetch KeyN a
BaseDigits = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a -> Maybe (f a)) -> f a -> Maybe (f a)
forall a b. (a -> b) -> a -> b
$ (\Int
b -> [Int
0..(Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]) (Int -> a) -> f Int -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyN Int -> f Int
Fetch KeyN f
fetch KeyN Int
Base
task Fetch KeyN f
_ KeyN a
_ = Maybe (f a)
forall a. Maybe a
Nothing

-- | An example key/value mapping consistent with the build 'task'.
fetch :: Applicative f => Fetch KeyN f
fetch :: forall (f :: * -> *). Applicative f => Fetch KeyN f
fetch KeyN a
key = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a) -> a -> f a
forall a b. (a -> b) -> a -> b
$ case KeyN a
key of
    KeyN a
Base       -> a
10
    KeyN a
Number     -> a
2018
    KeyN a
SplitDigit -> (Int
201, Int
8)
    KeyN a
LastDigit  -> a
8
    KeyN a
BaseDigits -> [Int
0..Int
9]

-- | Show the name of a key.
showKey :: ShowKey KeyN
showKey :: ShowKey KeyN
showKey KeyN a
key = case KeyN a
key of
    KeyN a
Base       -> String
"Base"
    KeyN a
Number     -> String
"Number"
    KeyN a
SplitDigit -> String
"SplitDigit"
    KeyN a
LastDigit  -> String
"LastDigit"
    KeyN a
BaseDigits -> String
"BaseDigits"