git.iko.soy/obelisk
on decrease-android-validity help sign in
obelisk/lib/command/src/Obelisk/App.hs
110 lines 3.0 kB history raw
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE LambdaCase #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE StandaloneDeriving #-}
9{-# LANGUAGE TemplateHaskell #-}
10{-# LANGUAGE TupleSections #-}
11module Obelisk.App where
13import Control.Lens
14import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
15import Control.Monad.Reader (MonadIO, ReaderT (..), ask, runReaderT)
16import Control.Monad.Writer (WriterT)
17import Control.Monad.State (StateT)
18import Control.Monad.Except (ExceptT, MonadError)
19import Control.Monad.Trans.Class (MonadTrans, lift)
20import Data.Text (Text)
21import System.Directory (XdgDirectory (XdgData), getXdgDirectory)
22import Control.Monad.Log (MonadLog)
24import Obelisk.CliApp
25 ( CliConfig
26 , CliLog
27 , CliThrow
28 , CliT (..)
29 , ProcessFailure
30 , AsProcessFailure (..)
31 , AsUnstructuredError (..)
32 , HasCliConfig
33 , Output
34 , runCli
35 )
37data ObeliskError
38 = ObeliskError_ProcessError
39 { obeliskError_err :: ProcessFailure
40 , obeliskError_mAnn :: Maybe Text
41 }
42 | ObeliskError_Unstructured Text
44makePrisms ''ObeliskError
46instance AsUnstructuredError ObeliskError where
47 asUnstructuredError = _ObeliskError_Unstructured
49-- Only project when the other field is null, otherwise we are not law abiding.
50instance AsProcessFailure ObeliskError where
51 asProcessFailure = _ObeliskError_ProcessError . prism (, Nothing) f
52 where f = \case
53 (pf, Nothing) -> Right pf
54 pann@(_, Just _) -> Left pann
56newtype Obelisk = Obelisk
57 { _obelisk_cliConfig :: CliConfig ObeliskError
58 }
60newtype ObeliskT m a = ObeliskT
61 { unObeliskT :: ReaderT Obelisk (CliT ObeliskError m) a
62 }
63 deriving
64 ( Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask
65 , MonadLog Output -- CliLog
66 , MonadError ObeliskError -- CliThrow ObeliskError
67 , HasCliConfig ObeliskError)
69instance MonadTrans ObeliskT where
70 lift = ObeliskT . lift . lift
72class Monad m => HasObelisk m where
73 getObelisk :: m Obelisk
75instance Monad m => HasObelisk (ObeliskT m) where
76 getObelisk = ObeliskT ask
78instance HasObelisk m => HasObelisk (ReaderT r m) where
79 getObelisk = lift getObelisk
81instance (Monoid w, HasObelisk m) => HasObelisk (WriterT w m) where
82 getObelisk = lift getObelisk
84instance HasObelisk m => HasObelisk (StateT r m) where
85 getObelisk = lift getObelisk
87instance HasObelisk m => HasObelisk (ExceptT e m) where
88 getObelisk = lift getObelisk
90runObelisk :: MonadIO m => Obelisk -> ObeliskT m a -> m a
91runObelisk c =
92 runCli (_obelisk_cliConfig c)
93 . flip runReaderT c
94 . unObeliskT
96type MonadInfallibleObelisk m =
97 ( CliLog m
98 , HasCliConfig ObeliskError m
99 , HasObelisk m
100 , MonadIO m
101 , MonadMask m
102 )
104type MonadObelisk m =
105 ( MonadInfallibleObelisk m
106 , CliThrow ObeliskError m
107 )
109getObeliskUserStateDir :: IO FilePath
110getObeliskUserStateDir = getXdgDirectory XdgData "obelisk"