{-# LANGUAGE QuasiQuotes #-} module Hinit.Types where import Data.Map.Strict (Map) import Data.String.Interpolate import Data.Text (Text, unpack) import GHC.Generics import Text.Mustache import qualified Text.Mustache.Types as M import Toml hiding (Bool, Text) import qualified Toml as T type Context = Map Text Val contextCodec :: TomlCodec Context contextCodec :: TomlCodec Context contextCodec = TomlBiMap Key Text -> (Key -> TomlCodec Val) -> Key -> TomlCodec Context forall k v. Ord k => TomlBiMap Key k -> (Key -> TomlCodec v) -> Key -> TomlCodec (Map k v) tableMap TomlBiMap Key Text _KeyText Key -> TomlCodec Val valCodec Key "custom" data ValType = Bool' | Text' deriving (ValType -> ValType -> Bool (ValType -> ValType -> Bool) -> (ValType -> ValType -> Bool) -> Eq ValType forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ValType -> ValType -> Bool $c/= :: ValType -> ValType -> Bool == :: ValType -> ValType -> Bool $c== :: ValType -> ValType -> Bool Eq, (forall x. ValType -> Rep ValType x) -> (forall x. Rep ValType x -> ValType) -> Generic ValType forall x. Rep ValType x -> ValType forall x. ValType -> Rep ValType x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ValType x -> ValType $cfrom :: forall x. ValType -> Rep ValType x Generic) instance Show ValType where show :: ValType -> String show ValType Bool' = String "Bool" show ValType Text' = String "Text" data Val = Bool Bool | Text Text deriving (Int -> Val -> ShowS [Val] -> ShowS Val -> String (Int -> Val -> ShowS) -> (Val -> String) -> ([Val] -> ShowS) -> Show Val forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Val] -> ShowS $cshowList :: [Val] -> ShowS show :: Val -> String $cshow :: Val -> String showsPrec :: Int -> Val -> ShowS $cshowsPrec :: Int -> Val -> ShowS Show, Val -> Val -> Bool (Val -> Val -> Bool) -> (Val -> Val -> Bool) -> Eq Val forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Val -> Val -> Bool $c/= :: Val -> Val -> Bool == :: Val -> Val -> Bool $c== :: Val -> Val -> Bool Eq, (forall x. Val -> Rep Val x) -> (forall x. Rep Val x -> Val) -> Generic Val forall x. Rep Val x -> Val forall x. Val -> Rep Val x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Val x -> Val $cfrom :: forall x. Val -> Rep Val x Generic) instance ToMustache Val where toMustache :: Val -> Value toMustache (Bool Bool b) = Bool -> Value M.Bool Bool b toMustache (Text Text t) = Text -> Value M.String Text t toTomlVal :: Val -> AnyValue toTomlVal :: Val -> AnyValue toTomlVal (Bool Bool b) = Value 'TBool -> AnyValue forall (t :: TValue). Value t -> AnyValue AnyValue (Value 'TBool -> AnyValue) -> Value 'TBool -> AnyValue forall a b. (a -> b) -> a -> b $ Bool -> Value 'TBool T.Bool Bool b toTomlVal (Text Text t) = Value 'TText -> AnyValue forall (t :: TValue). Value t -> AnyValue AnyValue (Value 'TText -> AnyValue) -> Value 'TText -> AnyValue forall a b. (a -> b) -> a -> b $ Text -> Value 'TText T.Text Text t fromTomlVal :: AnyValue -> Either TomlBiMapError Val fromTomlVal :: AnyValue -> Either TomlBiMapError Val fromTomlVal (AnyValue Value t v) | T.Bool Bool b <- Value t v = Val -> Either TomlBiMapError Val forall a b. b -> Either a b Right (Val -> Either TomlBiMapError Val) -> Val -> Either TomlBiMapError Val forall a b. (a -> b) -> a -> b $ Bool -> Val Bool Bool b | T.Text Text t <- Value t v = Val -> Either TomlBiMapError Val forall a b. b -> Either a b Right (Val -> Either TomlBiMapError Val) -> Val -> Either TomlBiMapError Val forall a b. (a -> b) -> a -> b $ Text -> Val Text Text t | Bool otherwise = TomlBiMapError -> Either TomlBiMapError Val forall a b. a -> Either a b Left (TomlBiMapError -> Either TomlBiMapError Val) -> TomlBiMapError -> Either TomlBiMapError Val forall a b. (a -> b) -> a -> b $ Text -> TomlBiMapError ArbitraryError [i|Expecting value of type Bool or Text, got #{tShow (valueType v)} instead|] _Val :: TomlBiMap Val AnyValue _Val :: TomlBiMap Val AnyValue _Val = BiMap TomlBiMapError AnyValue Val -> TomlBiMap Val AnyValue forall e a b. BiMap e a b -> BiMap e b a invert (BiMap TomlBiMapError AnyValue Val -> TomlBiMap Val AnyValue) -> BiMap TomlBiMapError AnyValue Val -> TomlBiMap Val AnyValue forall a b. (a -> b) -> a -> b $ (Val -> AnyValue) -> (AnyValue -> Either TomlBiMapError Val) -> BiMap TomlBiMapError AnyValue Val forall field object error. (field -> object) -> (object -> Either error field) -> BiMap error object field prism Val -> AnyValue toTomlVal AnyValue -> Either TomlBiMapError Val fromTomlVal valCodec :: Key -> TomlCodec Val valCodec :: Key -> TomlCodec Val valCodec = TomlBiMap Val AnyValue -> Key -> TomlCodec Val forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a match TomlBiMap Val AnyValue _Val instance HasCodec Val where hasCodec :: Key -> TomlCodec Val hasCodec = Key -> TomlCodec Val valCodec data VCS = Git | Mercurial | Darcs | Pijul | Other Text deriving (VCS -> VCS -> Bool (VCS -> VCS -> Bool) -> (VCS -> VCS -> Bool) -> Eq VCS forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: VCS -> VCS -> Bool $c/= :: VCS -> VCS -> Bool == :: VCS -> VCS -> Bool $c== :: VCS -> VCS -> Bool Eq, (forall x. VCS -> Rep VCS x) -> (forall x. Rep VCS x -> VCS) -> Generic VCS forall x. Rep VCS x -> VCS forall x. VCS -> Rep VCS x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep VCS x -> VCS $cfrom :: forall x. VCS -> Rep VCS x Generic) instance Show VCS where show :: VCS -> String show VCS Git = String "git" show VCS Mercurial = String "mercurial" show VCS Darcs = String "darcs" show VCS Pijul = String "pijul" show (Other Text t) = Text -> String unpack Text t vcsToT :: VCS -> Text vcsToT :: VCS -> Text vcsToT VCS v = case VCS v of VCS Git -> Text "Git" VCS Mercurial -> Text "Mercurial" VCS Darcs -> Text "Darcs" VCS Pijul -> Text "Pijul" Other Text t -> Text t textToVcs :: Text -> VCS textToVcs :: Text -> VCS textToVcs Text "Git" = VCS Git textToVcs Text "Mercurial" = VCS Mercurial textToVcs Text "Darcs" = VCS Darcs textToVcs Text "Pijul" = VCS Pijul textToVcs Text t = Text -> VCS Other Text t vcsCodec :: Key -> TomlCodec (Maybe VCS) vcsCodec :: Key -> TomlCodec (Maybe VCS) vcsCodec Key k = TomlCodec VCS -> TomlCodec (Maybe VCS) forall a. TomlCodec a -> TomlCodec (Maybe a) dioptional (TomlCodec VCS -> TomlCodec (Maybe VCS)) -> TomlCodec VCS -> TomlCodec (Maybe VCS) forall a b. (a -> b) -> a -> b $ (Text -> VCS) -> Codec Text Text -> Codec Text VCS forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> VCS textToVcs (Key -> Codec Text Text text Key k) Codec Text VCS -> (VCS -> Text) -> TomlCodec VCS forall field a object. Codec field a -> (object -> field) -> Codec object a .= VCS -> Text vcsToT instance HasCodec (Maybe VCS) where hasCodec :: Key -> TomlCodec (Maybe VCS) hasCodec = Key -> TomlCodec (Maybe VCS) vcsCodec