let cflags = "-Wall"
in { targets = [
        { target = "hello.o", dependencies = ["hello.c"], script = ''
              gcc ${cflags} -c hello.c -o hello.o''
        } ]
   }

do
   "_build//*.o" %> \out -> do
        let c = dropDirectory1 $ out -<.> "c"
        need [c]
        cmd_ "gcc -c" [c] "-o" [out]

let buildDir = "build"
let cflags = "-Wall"
let compileC = rule "${buildDir}/%.o" "%.c" 
                    \(out : Text) -> \(inp : Text) ->
        { target = out, dependencies = [ inp ], script = ''
          gcc ${cflags} -c ${inp} -o ${out}'' }

in {
   rules = [ compileC ]
}

let gnuplot =
    { match = Match.Class "gnuplot"
    , script = \(out : Text) -> \(inp : Text) -> ''
          gnuplot ${inp} > ${out}''
    }

in  { scriptClasses = [ gnuplot ]
    }

let Target : Type = < File : Text | Eval : Text >

let Rule : Type = { target : Text
                  , dependencies : List Text
                  , script : Text } 

let file = \(target : Text) -> \(deps : List Text) ->
           \(script : Text) ->
               { target = Target.File target
               , dependencies = deps
               , script = script }

let message = "Hello, World!"

in { shell = "bash"
   , rules = [
        file "hello.txt" ([] : List Text) ''
            echo "${message}" > {target}''
   ] }

let ms = ./schema.dhall

in [ ms.file "hello" [ "hello.c" ]
      ''
      gcc hello.c -o hello
      ''
   , ms.file "out.txt" [ "hello" ]
      ''
      ./hello > out.txt
      ''
   , ms.main [ "out.txt" ]
   ]

#include <stdio.h>
#include <stdlib.h>

int main() {
    printf("Hello, World!\n");
    return EXIT_SUCCESS;
}

let ms = ./schema.dhall
let entry =
    { name = "entry"
    , exists =
        ''
        test $(sqlite3 test.db 'select exists(select 1 from "messages" where "id" is 1)') == 1"
        ''
    , content =
        ''
        sqlite3 test.db 'select "content" from "messages" where "id" is 1'
        ''
    } : ms.Virtual
in
    [ ms.main [ "out.txt" ]
    , { target = [ ms.Target.File "out.txt" ]
      , dependency = [ ms.Target.Generic entry ]
      , script = Some
        ''
        sqlite3 test.db 'select "content" from "messages" where "id" is 1' > out.txt
        ''
      }
    , { target = [ ms.Target.Generic entry ]
      , dependency = [] : List ms.Target
      , script = Some
        ''
        sqlite3 test.db 'create table "messages" ("id" integer primary key, "content text")'
        sqlite3 test.db 'insert into "messages" ("content") values (\\'We apologise for the inconvenience\\')'
        ''
      }
    ]

{-| This submodule contains all type definitions and Dhall counterparts.
 -}
{-# LANGUAGE DuplicateRecordFields,OverloadedLabels #-}
{-# LANGUAGE DerivingStrategies,DerivingVia,DataKinds,UndecidableInstances #-}

module Milkshake.Data where

import RIO
import qualified RIO.Text as T
import qualified RIO.Map as M

import Data.Monoid.Generic (GenericSemigroup(..), GenericMonoid(..))
import Dhall (FromDhall, ToDhall, Decoder, union, constructor, auto, input, list)

<<haskell-types>>

{-# LANGUAGE DuplicateRecordFields,OverloadedLabels #-}
{-|
Contains functions to execute the script using Shake.
 -}
module Milkshake.Run where

import RIO
import qualified RIO.Text as T
import qualified RIO.Map as M

import Development.Shake (shake, shakeOptions)
import qualified Development.Shake as Shake
import Milkshake.Data
    ( readStmts,
      stmtsToConfig,
      Action(..),
      Call(..),
      Config(..),
      Target(Phony, File) )
import Milkshake.Error ( MilkshakeError(..) )

{-| Get `FilePath` from `Target` -}
targetPath :: Target -> Maybe FilePath
targetPath (File path) = Just $ T.unpack path
targetPath _ = Nothing

{-| Checks if target is a file -}
isFileTarget :: Target -> Bool
isFileTarget (File _) = True
isFileTarget _        = False

{-| Create `Shake.Rules` from an `Action`.
 -}
enter :: Action -> Shake.Rules ()
<<enter-action>>
enter Action { target = ts@(_:_), .. }
    | all isFileTarget ts =
          tgtPaths Shake.&%> \_ -> do
              Shake.need $ mapMaybe targetPath dependency
              mapM_ runScript script
    | otherwise           = mempty
    where tgtPaths = mapMaybe targetPath ts
enter _ = mempty

{-| Helper function that creates a `Shake.Action ()` from a scriptlet. -}
runScript :: Text -> Shake.Action ()
runScript = mapM_ (Shake.cmd_ Shake.Shell) . lines . T.unpack

let Call : Type =
    { name : Text
    } //\\ (Dependency (List Target) (List Target))

{-| The `Call` is like a function call, where the `Rule` is the function
    and `target` and `dependecy` are the arguments. -}
data Call = Call
    { name :: Text                  -- ^ the name of the rule to trigger
    , target :: [ Target ]          -- ^ the targets
    , dependency :: [ Target ]      -- ^ the dependencies
    } deriving (Generic, Show)

instance FromDhall Call

let Watch : Type =
    { paths : List Text
    , target : Target
    }

let Stmt : Type =
    < Action  : Action
    | Rule    : Rule
    | Call : Call
    | Include : Text
    | Watch   : Watch
    | Main    : List Text >

let action = \(tgt : List Target) -> \(dep : List Target) -> \(script : Optional Text) ->
    Stmt.Action { target = tgt, dependency = dep, script = script }
let rule = \(name : Text) -> \(gen : Generator) ->
    Stmt.Rule { name = name, gen = gen }
let call = \(name : Text) -> \(tgt : List Target) -> \(dep : List Target) ->
    Stmt.Call { name = name, target = tgt, dependency = dep }
let include = Stmt.Include
let main = Stmt.Main
let watch = \(paths : List Text) -> \(tgt : Target) ->
    Stmt.Watch { paths = paths, target = tgt }

{-| The Milkshake script is an unordered list of statements. The 'Stmt' type 
 encodes statements in a Milkshake script.
 -}
data Stmt
    = StmtAction Action         {-^ -}
    | StmtRule Rule
    | StmtCall Call
    | StmtInclude FilePath
    | StmtMain [FilePath]
    <<stmt-type>>

{-| To decode a list of Milkshake statements from the Dhall configuration
    use this decoder.

  >>> input (list stmt) "(entangled.dhall).milkshake"
  -}
stmt :: Decoder Stmt
stmt = union (
       (StmtAction  <$> constructor "Action" auto)
    <> (StmtRule    <$> constructor "Rule" auto)
    <> (StmtCall <$> constructor "Call" auto)
    <> (StmtInclude <$> constructor "Include" auto)
    <> (StmtMain    <$> constructor "Main" auto)
    <<stmt-decoder>>
    )

{-| Read a list of statements from a script. -}
readStmts :: (MonadIO m) => FilePath -> m [Stmt]
readStmts path = liftIO $ input (list stmt) (T.pack path)

let fileName = \(a : Target) ->
    merge { File = \(x : Text) -> Some x
          , Generic = \(_ : Virtual) -> None Text
          , Phony =   \(_ : Text) -> None Text } a

let Target/isFile = \(a : Target) ->
    merge { File = \(_ : Text) -> True
          , Generic = \(_ : Virtual) -> False
          , Phony = \(_ : Text) -> False } a

let getFiles = \(a : List Target) ->
    Prelude.List.unpackOptionals Text (List/map Target (Optional Text) fileName a)

let testGetFiles = assert : getFiles [ Target.File "a", Target.Phony "m", Target.File "b" ]
                        === [ "a", "b"]

let fileRule = \(name : Text) -> \(f : Text -> List Text -> Text) ->
     rule name (\(tgt : List Target) -> \(dep : List Target) ->
        merge { Some = \(inp : Text) -> Some (f inp (getFiles dep))
            , None = None Text } (List/head Text (getFiles tgt)))

let fileAction = \(target : Text) -> \(deps : List Text) -> \(script : Text) ->
    Stmt.Action
        { target = [ Target.File target ]
        , dependency = List/map Text Target Target.File deps
        , script = Some script }

let fileCall = \(name : Text) -> \(tgt : Text) -> \(deps : List Text) ->
    call name [Target.File tgt] (List/map Text Target Target.File deps)

let mainAction = \(deps : List Text) ->
    Stmt.Action
        { target = [ Target.Phony "main" ]
        , dependency = List/map Text Target Target.File deps
        , script = None Text }

let Text/concatSep = https://prelude.dhall-lang.org/Text/concatSep
    sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58

let ms = ./schema.dhall

in  [ ms.fileRule "compile" (\(tgt : Text) -> \(deps : List Text) ->
        ''
        gcc -c ${Text/concatSep " " deps} -o ${tgt}
        '')
    , ms.fileRule "link" (\(tgt : Text) -> \(deps : List Text) ->
        ''
        gcc ${Text/concatSep " " deps} -o ${tgt}
        '')

    , ms.call "compile"
        [ ms.Target.File "hello.o" ]
        [ ms.Target.File "hello.c" ]
    , ms.call "link"
        [ ms.Target.File "hello" ]
        [ ms.Target.File "hello.o" ]

    , ms.fileAction "out.txt" [ "hello" ]
        ''
        ./hello > out.txt
        ''
    , ms.mainAction [ "out.txt" ]
    ] : List ms.Stmt

{-| Transposed data record of a list of `Stmt`. -}
data Config = Config
    { rules      :: M.Map Text Generator
    , triggers   :: [Call]
    , actions    :: [Action]
    , includes   :: [FilePath]
    , mainTarget :: [FilePath]
    , watches    :: [Watch] }
    deriving (Generic)
    deriving Semigroup via GenericSemigroup Config
    deriving Monoid    via GenericMonoid Config

{-| Groups a list of 'Stmt' into a 'Config' record. -}
stmtsToConfig :: [Stmt] -> Config
stmtsToConfig = foldMap toConfig
    where toConfig (StmtAction a) = mempty { actions = [a] }
          toConfig (StmtRule Rule {..})   = mempty { rules = M.singleton name gen }
          toConfig (StmtCall t) = mempty { triggers = [t] }
          toConfig (StmtInclude i) = mempty { includes = [i] }
          toConfig (StmtMain m) = mempty { mainTarget = m }
          toConfig (StmtWatch w) = mempty { watches = [w] }

{-| Read a script directly to `Config` record. -}
readConfig :: (MonadIO m) => FilePath -> m Config
readConfig f = stmtsToConfig <$> readStmts f

{-# LANGUAGE NoImplicitPrelude,DuplicateRecordFields,OverloadedLabels #-}
module Layer2Spec (spec) where

import RIO
-- import qualified RIO.Text as T
import Test.Hspec

import Milkshake.Data (Action(..), Target(..), readStmts, Config(..), stmtsToConfig)
import Milkshake.Run (enter, fromCall)

import Development.Shake (shake, shakeOptions)
import Util (runInTmp)

spec :: Spec
spec = describe "Layer2" $ do
    it "can load a configuration" $ runInTmp ["./test/Layer2/*"] $ do
        cfg <- stmtsToConfig <$> readStmts "./test2.dhall"
        (actions cfg) `shouldSatisfy` any (\Action{..} -> target == [Phony "main"])
    it "can run all actions" $ runInTmp ["./test/Layer1/hello.c", "./test/Layer2/*"] $ do
        cfg <- stmtsToConfig <$> readStmts "./test2.dhall"
        (actions cfg) `shouldSatisfy` any (\Action{..} -> target == [Phony "main"])
        case mapM (fromCall cfg) (triggers cfg) of
            Left e -> throwM e
            Right as -> do
                let actionList = (actions cfg) <> as
                shake shakeOptions (mapM_ enter actionList)
                result <- readFileUtf8 "out.txt"
                result `shouldBe` "Hello, World!\n"

let ms = ./schema.dhall

in \(x : Natural) ->
    [ ms.fileAction "answer.txt" ([] : List Text)
        ''
        echo "${Natural/show x}" > answer.txt
        ''
    ]

let ms = ./schema.dhall

in  [ ms.fileAction "include.dhall" ([] : List Text)
        ''
        echo "./template.dhall 42" | dhall > include.dhall
        ''
    , ms.include "include.dhall"
    , ms.main ["answer.txt"]
    ]

{-# LANGUAGE NoImplicitPrelude,DuplicateRecordFields,OverloadedLabels #-}
module Layer3Spec (spec) where

import RIO
import Test.Hspec

import Milkshake.Data (readStmts, Config(..), stmtsToConfig)
import Milkshake.Run (enter, loadIncludes, immediateActions)

import Development.Shake (shake, shakeOptions, want)
import Util (runInTmp)

spec :: Spec
spec = describe "Layer3" $ do
    it "can load a configuration" $ runInTmp ["./test/Layer3/*"] $ do
        cfg <- stmtsToConfig <$> readStmts "./test1.dhall"
        mainTarget cfg `shouldSatisfy` (not . null)
        gen <- stmtsToConfig <$> readStmts "./template.dhall 42"
        actions gen `shouldSatisfy` (not . null)
    it "can run all actions" $ runInTmp ["./test/Layer3/*"] $ do
        cfg <- loadIncludes . stmtsToConfig =<< readStmts "./test1.dhall"
        actions <- either throwM return $ immediateActions cfg
        shake shakeOptions (mapM_ enter actions >> want (mainTarget cfg))
        result <- readFileUtf8 "answer.txt"
        result `shouldBe` "42\n"

{-| Given a `Config` and a `Call`, creates an `Action`. -}
fromCall :: Config -> Call -> Either MilkshakeError Action
fromCall cfg Call{..} = case rule of
    Just r  -> Right $ Action target dependency (r target dependency)
    Nothing -> Left $ ConfigError $ "No such rule: " <> name
    where rule = rules cfg M.!? name

{-| Looks for actions that are immediately runnable. These are the plain
  `Action` statements, as well as calls to rules. The calls are expanded
  into actions, and a list of all actions is returned. -}
immediateActions :: Config -> Either MilkshakeError [Action]
immediateActions cfg@Config{..} = do
    triggered <- mapM (fromCall cfg) triggers
    return $ actions <> triggered

{-| Recursively loads include statements, until no includes are left. -}
loadIncludes :: (MonadThrow m, MonadIO m) => Config -> m Config
loadIncludes cfg@Config{includes=[]} = return cfg
loadIncludes cfg@Config{includes} = do
    actions <- either throwM return $ immediateActions cfg
    liftIO $ shake shakeOptions (mapM_ enter actions >> Shake.want includes)
    stmts <- foldMapM readStmts (map ("./" <>) includes)
    loadIncludes $ cfg {includes = mempty} <> stmtsToConfig stmts