git.iko.soy/obelisk
on ae@static-which-prefetch help sign in
obelisk/lib/command/src/Obelisk/App.hs
113 lines 3.1 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.Fail (MonadFail)
16import Control.Monad.Reader (MonadIO, ReaderT (..), ask, runReaderT)
17import Control.Monad.Writer (WriterT)
18import Control.Monad.State (StateT)
19import Control.Monad.Except (ExceptT, MonadError)
20import Control.Monad.Trans.Class (MonadTrans, lift)
21import Data.Text (Text)
22import System.Directory (XdgDirectory (XdgData), getXdgDirectory)
23import Control.Monad.Log (MonadLog)
25import Obelisk.CliApp
26 ( CliConfig
27 , CliLog
28 , CliThrow
29 , CliT (..)
30 , ProcessFailure
31 , AsProcessFailure (..)
32 , AsUnstructuredError (..)
33 , HasCliConfig
34 , Output
35 , runCli
36 )
38data ObeliskError
39 = ObeliskError_ProcessError
40 { obeliskError_err :: ProcessFailure
41 , obeliskError_mAnn :: Maybe Text
42 }
43 | ObeliskError_Unstructured Text
45makePrisms ''ObeliskError
47instance AsUnstructuredError ObeliskError where
48 asUnstructuredError = _ObeliskError_Unstructured
50-- Only project when the other field is null, otherwise we are not law abiding.
51instance AsProcessFailure ObeliskError where
52 asProcessFailure = _ObeliskError_ProcessError . prism (, Nothing) f
53 where f = \case
54 (pf, Nothing) -> Right pf
55 pann@(_, Just _) -> Left pann
57newtype Obelisk = Obelisk
58 { _obelisk_cliConfig :: CliConfig ObeliskError
59 }
61newtype ObeliskT m a = ObeliskT
62 { unObeliskT :: ReaderT Obelisk (CliT ObeliskError m) a
63 }
64 deriving
65 ( Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadFail
66 , MonadLog Output -- CliLog
67 , MonadError ObeliskError -- CliThrow ObeliskError
68 , HasCliConfig ObeliskError
69 )
71instance MonadTrans ObeliskT where
72 lift = ObeliskT . lift . lift
74class Monad m => HasObelisk m where
75 getObelisk :: m Obelisk
77instance Monad m => HasObelisk (ObeliskT m) where
78 getObelisk = ObeliskT ask
80instance HasObelisk m => HasObelisk (ReaderT r m) where
81 getObelisk = lift getObelisk
83instance (Monoid w, HasObelisk m) => HasObelisk (WriterT w m) where
84 getObelisk = lift getObelisk
86instance HasObelisk m => HasObelisk (StateT r m) where
87 getObelisk = lift getObelisk
89instance HasObelisk m => HasObelisk (ExceptT e m) where
90 getObelisk = lift getObelisk
92runObelisk :: MonadIO m => Obelisk -> ObeliskT m a -> m a
93runObelisk c =
94 runCli (_obelisk_cliConfig c)
95 . flip runReaderT c
96 . unObeliskT
98type MonadInfallibleObelisk m =
99 ( CliLog m
100 , HasCliConfig ObeliskError m
101 , HasObelisk m
102 , MonadIO m
103 , MonadMask m
104 )
106type MonadObelisk m =
107 ( MonadInfallibleObelisk m
108 , CliThrow ObeliskError m
109 , MonadFail m
110 )
112getObeliskUserStateDir :: IO FilePath
113getObeliskUserStateDir = getXdgDirectory XdgData "obelisk"