1{-# LANGUAGE Rank2Types #-}
2module ElmFormat.Execute (forHuman, forMachine, run) where
3
4{-| This module provides executors that can take streams of Operations and
5perform IO.
6-}
7
8import Prelude hiding (init)
9import Elm.Utils ((|>))
10import Control.Monad.State
11import Control.Monad.Free
12import ElmFormat.Operation
13import ElmFormat.World
14import ElmVersion
15
16import qualified ElmFormat.FileStore as FileStore
17import qualified ElmFormat.FileWriter as FileWriter
18import qualified ElmFormat.InputConsole as InputConsole
19import qualified ElmFormat.OutputConsole as OutputConsole
20import qualified Messages.Formatter.HumanReadable as HumanReadable
21import qualified Messages.Formatter.Json as Json
22
23
24data Program m opF state = Program
25    { init :: (m (), state)
26    , step :: forall a. opF a -> StateT state m a
27    , done :: state -> m ()
28    }
29
30
31run :: World m => Program m opF state -> Free opF a -> m a
32run program operations =
33    do
34        let Program init step done = program
35        let (initIO, initState) = init
36        initIO
37        (result, finalState) <-
38            operations
39                |> foldFree step
40                |> flip runStateT initState
41        done finalState
42        return result
43
44
45{-| Execute Operations in a fashion appropriate for interacting with humans. -}
46forHuman :: World m => Bool -> Program m OperationF ()
47forHuman autoYes =
48    Program
49        { init = (return (), ())
50        , step = \operation ->
51              case operation of
52                  InFileStore op -> lift $ FileStore.execute op
53                  InInfoFormatter op -> lift $ HumanReadable.format autoYes op
54                  InInputConsole op -> lift $ InputConsole.execute op
55                  InOutputConsole op -> lift $ OutputConsole.execute op
56                  InFileWriter op -> lift $ FileWriter.execute op
57        , done = \() -> return ()
58        }
59
60
61{-| Execute Operations in a fashion appropriate for use by automated scripts. -}
62forMachine :: World m => ElmVersion -> Bool -> Program m OperationF Bool
63forMachine elmVersion autoYes =
64    Program
65        { init = Json.init
66        , step = \operation ->
67            case operation of
68                InFileStore op -> lift $ FileStore.execute op
69                InInfoFormatter op -> Json.format elmVersion autoYes op
70                InInputConsole op -> lift $ InputConsole.execute op
71                InOutputConsole op -> lift $ OutputConsole.execute op
72                InFileWriter op -> lift $ FileWriter.execute op
73        , done = const Json.done
74        }
75