{-# 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