module Zifter.Zift.Types where
import Prelude
import Control.Concurrent.STM
import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.Fail as Fail
import Control.Monad.IO.Class
import Data.Validity
import Data.Validity.Path ()
import GHC.Generics
import Path
import System.Console.ANSI (SGR)
import Zifter.OptParse.Types
data ZiftToken =
ZiftToken [LR]
(Maybe ZiftOutput)
deriving (Show, Eq, Generic)
data ZiftOutput = ZiftOutput
{ outputColors :: [SGR]
, outputMessage :: String
} deriving (Show, Eq, Generic)
data ZiftContext = ZiftContext
{ rootdir :: Path Abs Dir
, tmpdir :: Path Abs Dir
, settings :: Settings
, printChan :: TChan ZiftToken
, recursionList :: [LR]
} deriving (Generic)
data LR
= L
| R
deriving (Show, Eq, Generic)
instance Validity ZiftContext where
isValid = isValid . rootdir
#if MIN_VERSION_validity(0,4,0)
validate zc = rootdir zc <?!> "rootdir"
#endif
data Zift a where
ZiftPure :: a -> Zift a
ZiftCtx :: Zift ZiftContext
ZiftPrint :: ZiftOutput -> Zift ()
ZiftFail :: String -> Zift a
ZiftIO :: IO a -> Zift a
ZiftFmap :: (a -> b) -> Zift a -> Zift b
ZiftApp :: Zift (a -> b) -> Zift a -> Zift b
ZiftBind :: Zift a -> (a -> Zift b) -> Zift b
instance Monoid a => Monoid (Zift a) where
mempty = ZiftPure mempty
mappend z1 z2 = mappend <$> z1 <*> z2
instance Functor Zift where
fmap = ZiftFmap
instance Applicative Zift where
pure = ZiftPure
(<*>) = ZiftApp
instance Monad Zift where
(>>=) = ZiftBind
fail = Fail.fail
instance MonadFail Zift where
fail = ZiftFail
instance MonadIO Zift where
liftIO = ZiftIO
instance MonadThrow Zift where
throwM = ZiftIO . throwM
data ZiftResult a
= ZiftSuccess a
| ZiftFailed String
deriving (Show, Eq, Generic)
instance Validity a => Validity (ZiftResult a) where
isValid (ZiftSuccess a) = isValid a
isValid _ = True
instance Monoid a => Monoid (ZiftResult a) where
mempty = ZiftSuccess mempty
mappend z1 z2 = mappend <$> z1 <*> z2
instance Functor ZiftResult where
fmap f (ZiftSuccess a) = ZiftSuccess $ f a
fmap _ (ZiftFailed s) = ZiftFailed s
instance Applicative ZiftResult where
pure = ZiftSuccess
(ZiftSuccess f) <*> (ZiftSuccess a) = ZiftSuccess $ f a
(ZiftFailed e) <*> (ZiftSuccess _) = ZiftFailed e
(ZiftSuccess _) <*> (ZiftFailed e) = ZiftFailed e
(ZiftFailed e1) <*> (ZiftFailed e2) = ZiftFailed $ unwords [e1, e2]
instance Monad ZiftResult where
(ZiftSuccess a) >>= fb = fb a
(ZiftFailed e) >>= _ = ZiftFailed e
instance MonadFail ZiftResult where
fail = ZiftFailed