module Elm.Types
( Options (..)
, defaultOptions
, Primitive (..)
, Expr (..)
, isProduct
, Generator (..)
, ToElm (..)
, genericToElm
) where
import Data.Char
import Data.Text (Text)
import Data.Time
import GHC.Generics
data Options = Options
{ recordSelectorModifier :: String -> String
, jsonSelectorModifier :: String -> String
}
defaultOptions :: Options
defaultOptions = Options
{ recordSelectorModifier = id
, jsonSelectorModifier = id
}
data Primitive = Bool | Char | String | Float | Date | Int | Maybe | List
deriving (Show, Eq)
data Expr = DataType String Expr
| Record String Expr
| Constructor String Expr
| Selector String String Expr
| Field Expr
| Unit
| Sum Expr Expr
| Product Expr Expr
| Primitive Primitive
deriving (Show)
isProduct :: Expr -> Bool
isProduct (Product (Primitive List) (Primitive Char)) = False
isProduct (Product _ _) = True
isProduct _ = False
data Generator = Type | Decoder | ListDecoder | Encoder
deriving (Show, Eq, Ord)
class ToElm a where
toElm :: a -> Expr
default toElm :: (Generic a, GToElm (Rep a)) => a -> Expr
toElm = genericToElm defaultOptions
instance ToElm Bool where
toElm _ = Primitive Bool
instance ToElm Char where
toElm _ = Primitive Char
instance ToElm Text where
toElm _ = Primitive String
instance ToElm Float where
toElm _ = Primitive Float
instance ToElm Double where
toElm _ = Primitive Float
instance ToElm UTCTime where
toElm _ = Primitive Date
instance ToElm Int where
toElm _ = Primitive Int
instance (ToElm a) => ToElm (Maybe a) where
toElm _ = Product (Primitive Maybe) $ toElm (undefined :: a)
instance (ToElm a) => ToElm [a] where
toElm _ = Product (Primitive List) $ toElm (undefined :: a)
class GToElm f where
gToElm :: Options -> f a -> Expr
instance (GToElm f, Datatype d) => GToElm (D1 d f) where
gToElm opts d@(M1 b) =
DataType name expr
where name = datatypeName d
expr = gToElm opts b
instance (GToElm f, Constructor c) => GToElm (C1 c f) where
gToElm opts c@(M1 s) =
if conIsRecord c
then Record name expr
else Constructor name expr
where name = conName c
expr = gToElm opts s
instance (Selector c,GToElm f) => GToElm (S1 c f) where
gToElm opts@(Options {..}) s@(M1 x) = Selector
(dcFirst $ notEmpty "Record" $ recordSelectorModifier name)
(notEmpty "Json" $ jsonSelectorModifier name) expr
where name = selName s
expr = gToElm opts x
notEmpty ident as = if length as > 0
then as
else error $ ident ++ "selector modifier results in empty selector"
dcFirst (a:as) = toLower a : as
dcFirst _ = undefined
instance (ToElm c) => GToElm (K1 R c) where
gToElm _ (K1 x) =
Field $ toElm x
instance GToElm U1 where
gToElm _ _ =
Unit
instance (GToElm f, GToElm g) => GToElm (f :+: g) where
gToElm opts _ =
Sum (gToElm opts (undefined :: f p)) (gToElm opts (undefined :: g p))
instance (GToElm f, GToElm g) => GToElm (f :*: g) where
gToElm opts _ =
Product (gToElm opts (undefined :: f p)) (gToElm opts (undefined :: g p))
genericToElm :: (Generic a, GToElm (Rep a)) => Options -> a -> Expr
genericToElm opts = gToElm opts . from