{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | This module converts an API specified with the DSL into a
-- JSON-encoded object so that it can be used in clients.
module Data.API.API
    ( apiAPI
    , extractAPI
    , convertAPI
    , unconvertAPI
    ) where

import           Data.API.API.DSL
import qualified Data.API.API.Gen               as D
import           Data.API.Types
import           Data.API.JSON

import           Data.Aeson
import qualified Data.CaseInsensitive           as CI
import qualified Data.Text                      as T
import           Control.Applicative
import           Text.Regex
import           Prelude


-- | Take an API spec and generate a JSON description of the API
extractAPI :: API -> Value
extractAPI :: API -> Value
extractAPI = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. API -> APISpec
convertAPI

convertAPI :: API -> D.APISpec
convertAPI :: API -> APISpec
convertAPI API
api = [ APINode -> APINode
convert APINode
an | ThNode APINode
an <- API
api ]

convert :: APINode -> D.APINode
convert :: APINode -> APINode
convert (APINode{String
Conversion
Prefix
Spec
TypeName
anConvert :: APINode -> Conversion
anSpec :: APINode -> Spec
anPrefix :: APINode -> Prefix
anComment :: APINode -> String
anName :: APINode -> TypeName
anConvert :: Conversion
anSpec :: Spec
anPrefix :: Prefix
anComment :: String
anName :: TypeName
..}) =
    D.APINode
        { _an_name :: Text
D._an_name    = TypeName -> Text
_TypeName               TypeName
anName
        , _an_comment :: Text
D._an_comment = String -> Text
T.pack                  String
anComment
        , _an_prefix :: Text
D._an_prefix  = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original    Prefix
anPrefix
        , _an_spec :: Spec
D._an_spec    = Spec -> Spec
convert_spec            Spec
anSpec
        , _an_convert :: Maybe Conversion
D._an_convert = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName, FieldName) -> Conversion
convert_conversion Conversion
anConvert
        }

convert_spec :: Spec -> D.Spec
convert_spec :: Spec -> Spec
convert_spec Spec
sp =
    case Spec
sp of
      SpNewtype SpecNewtype
sn -> SpecNewtype -> Spec
D.SP_newtype forall a b. (a -> b) -> a -> b
$ SpecNewtype -> SpecNewtype
convert_specnt            SpecNewtype
sn
      SpRecord  SpecRecord
sr -> [Field] -> Spec
D.SP_record  forall a b. (a -> b) -> a -> b
$ [(FieldName, FieldType)] -> [Field]
convert_fields forall a b. (a -> b) -> a -> b
$ SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr
      SpUnion   SpecUnion
su -> [Field] -> Spec
D.SP_union   forall a b. (a -> b) -> a -> b
$ [(FieldName, (APIType, String))] -> [Field]
convert_union  forall a b. (a -> b) -> a -> b
$ SpecUnion -> [(FieldName, (APIType, String))]
suFields SpecUnion
su
      SpEnum    SpecEnum
se -> [Text] -> Spec
D.SP_enum    forall a b. (a -> b) -> a -> b
$ [(FieldName, String)] -> [Text]
convert_alts   forall a b. (a -> b) -> a -> b
$ SpecEnum -> [(FieldName, String)]
seAlts   SpecEnum
se
      SpSynonym APIType
ty -> APIType -> Spec
D.SP_synonym forall a b. (a -> b) -> a -> b
$ APIType -> APIType
convert_type              APIType
ty

convert_conversion :: (FieldName,FieldName) -> D.Conversion
convert_conversion :: (FieldName, FieldName) -> Conversion
convert_conversion (FieldName
inj,FieldName
prj) =
    D.Conversion
        { _cv_injection :: Text
D._cv_injection  = FieldName -> Text
_FieldName FieldName
inj
        , _cv_projection :: Text
D._cv_projection = FieldName -> Text
_FieldName FieldName
prj
        }

convert_specnt :: SpecNewtype -> D.SpecNewtype
convert_specnt :: SpecNewtype -> SpecNewtype
convert_specnt SpecNewtype
sn =
    D.SpecNewtype
        { _sn_type :: BasicType
D._sn_type   = BasicType -> BasicType
convert_basic   forall a b. (a -> b) -> a -> b
$  SpecNewtype -> BasicType
snType   SpecNewtype
sn
        , _sn_filter :: Maybe Filter
D._sn_filter = Filter -> Filter
convert_filter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn
        }

convert_filter :: Filter -> D.Filter
convert_filter :: Filter -> Filter
convert_filter Filter
ftr =
    case Filter
ftr of
      FtrStrg RegEx{Text
Regex
re_regex :: RegEx -> Regex
re_text :: RegEx -> Text
re_regex :: Regex
re_text :: Text
..}    -> RegularExpression -> Filter
D.FT_string  forall a b. (a -> b) -> a -> b
$ Text -> RegularExpression
D.RegularExpression Text
re_text
      FtrIntg IntRange{Maybe Int
ir_hi :: IntRange -> Maybe Int
ir_lo :: IntRange -> Maybe Int
ir_hi :: Maybe Int
ir_lo :: Maybe Int
..} -> IntRange -> Filter
D.FT_integer forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> IntRange
D.IntRange  Maybe Int
ir_lo Maybe Int
ir_hi
      FtrUTC  UTCRange{Maybe UTCTime
ur_hi :: UTCRange -> Maybe UTCTime
ur_lo :: UTCRange -> Maybe UTCTime
ur_hi :: Maybe UTCTime
ur_lo :: Maybe UTCTime
..} -> UTCRange -> Filter
D.FT_utc     forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Maybe UTCTime -> UTCRange
D.UTCRange  Maybe UTCTime
ur_lo Maybe UTCTime
ur_hi

convert_fields :: [(FieldName, FieldType)] -> [D.Field]
convert_fields :: [(FieldName, FieldType)] -> [Field]
convert_fields [(FieldName, FieldType)]
al = forall a b. (a -> b) -> [a] -> [b]
map (FieldName, FieldType) -> Field
f [(FieldName, FieldType)]
al
  where
    f :: (FieldName, FieldType) -> Field
f (FieldName
fn,FieldType
fty) =
        D.Field
            { _fd_name :: Text
D._fd_name     = FieldName -> Text
_FieldName FieldName
fn
            , _fd_type :: APIType
D._fd_type     = APIType -> APIType
convert_type forall a b. (a -> b) -> a -> b
$ FieldType -> APIType
ftType FieldType
fty
            , _fd_readonly :: Bool
D._fd_readonly = FieldType -> Bool
ftReadOnly FieldType
fty
            , _fd_default :: Maybe DefaultValue
D._fd_default  = DefaultValue -> DefaultValue
convert_default forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldType -> Maybe DefaultValue
ftDefault FieldType
fty
            , _fd_comment :: Text
D._fd_comment  = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FieldType -> String
ftComment FieldType
fty
            }

convert_union :: [(FieldName, (APIType, MDComment))] -> [D.Field]
convert_union :: [(FieldName, (APIType, String))] -> [Field]
convert_union [(FieldName, (APIType, String))]
al = forall a b. (a -> b) -> [a] -> [b]
map (FieldName, (APIType, String)) -> Field
f [(FieldName, (APIType, String))]
al
  where
    f :: (FieldName, (APIType, String)) -> Field
f (FieldName
fn,(APIType
ty,String
co)) =
        D.Field
            { _fd_name :: Text
D._fd_name     = FieldName -> Text
_FieldName FieldName
fn
            , _fd_type :: APIType
D._fd_type     = APIType -> APIType
convert_type APIType
ty
            , _fd_readonly :: Bool
D._fd_readonly = Bool
False
            , _fd_default :: Maybe DefaultValue
D._fd_default  = forall a. Maybe a
Nothing
            , _fd_comment :: Text
D._fd_comment  = String -> Text
T.pack String
co
            }

convert_alts :: [(FieldName,MDComment)] -> [T.Text]
convert_alts :: [(FieldName, String)] -> [Text]
convert_alts [(FieldName, String)]
fns = forall a b. (a -> b) -> [a] -> [b]
map (FieldName -> Text
_FieldName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(FieldName, String)]
fns

convert_type :: APIType -> D.APIType
convert_type :: APIType -> APIType
convert_type APIType
ty0 =
    case APIType
ty0 of
      TyList  APIType
ty    -> APIType -> APIType
D.TY_list  forall a b. (a -> b) -> a -> b
$ APIType -> APIType
convert_type     APIType
ty
      TyMaybe APIType
ty    -> APIType -> APIType
D.TY_maybe forall a b. (a -> b) -> a -> b
$ APIType -> APIType
convert_type     APIType
ty
      TyName  TypeName
tn    -> TypeRef -> APIType
D.TY_ref   forall a b. (a -> b) -> a -> b
$ TypeName -> TypeRef
convert_ref      TypeName
tn
      TyBasic BasicType
bt    -> BasicType -> APIType
D.TY_basic forall a b. (a -> b) -> a -> b
$ BasicType -> BasicType
convert_basic    BasicType
bt
      APIType
TyJSON        -> Int -> APIType
D.TY_json    Int
0

convert_ref :: TypeName -> D.TypeRef
convert_ref :: TypeName -> TypeRef
convert_ref (TypeName Text
tn) = Text -> TypeRef
D.TypeRef Text
tn

convert_basic :: BasicType -> D.BasicType
convert_basic :: BasicType -> BasicType
convert_basic BasicType
bt =
    case BasicType
bt of
      BasicType
BTstring -> BasicType
D.BT_string
      BasicType
BTbinary -> BasicType
D.BT_binary
      BasicType
BTbool   -> BasicType
D.BT_boolean
      BasicType
BTint    -> BasicType
D.BT_integer
      BasicType
BTutc    -> BasicType
D.BT_utc

convert_default :: DefaultValue -> D.DefaultValue
convert_default :: DefaultValue -> DefaultValue
convert_default DefaultValue
DefValList       = Int -> DefaultValue
D.DV_list    Int
0
convert_default DefaultValue
DefValMaybe      = Int -> DefaultValue
D.DV_maybe   Int
0
convert_default (DefValString Text
s) = Text -> DefaultValue
D.DV_string  Text
s
convert_default (DefValBool   Bool
b) = Bool -> DefaultValue
D.DV_boolean Bool
b
convert_default (DefValInt    Int
i) = Int -> DefaultValue
D.DV_integer Int
i
convert_default (DefValUtc    UTCTime
u) = UTCTime -> DefaultValue
D.DV_utc     UTCTime
u



-- | Generate an API spec from the JSON

instance FromJSONWithErrs Thing where
    parseJSONWithErrs :: Value -> ParserWithErrs Thing
parseJSONWithErrs Value
v = (APINode -> Thing
ThNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> APINode
unconvert) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs Value
v

unconvertAPI :: D.APISpec -> API
unconvertAPI :: APISpec -> API
unconvertAPI = forall a b. (a -> b) -> [a] -> [b]
map (APINode -> Thing
ThNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> APINode
unconvert)

unconvert :: D.APINode -> APINode
unconvert :: APINode -> APINode
unconvert (D.APINode{Maybe Conversion
Text
Spec
_an_convert :: Maybe Conversion
_an_spec :: Spec
_an_prefix :: Text
_an_comment :: Text
_an_name :: Text
_an_convert :: APINode -> Maybe Conversion
_an_spec :: APINode -> Spec
_an_prefix :: APINode -> Text
_an_comment :: APINode -> Text
_an_name :: APINode -> Text
..}) =
    APINode
        { anName :: TypeName
anName    = Text -> TypeName
TypeName                  Text
_an_name
        , anComment :: String
anComment = Text -> String
T.unpack                  Text
_an_comment
        , anPrefix :: Prefix
anPrefix  = forall s. FoldCase s => s -> CI s
CI.mk forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack          Text
_an_prefix
        , anSpec :: Spec
anSpec    = Spec -> Spec
unconvert_spec            Spec
_an_spec
        , anConvert :: Conversion
anConvert = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Conversion -> (FieldName, FieldName)
unconvert_conversion Maybe Conversion
_an_convert
        }

unconvert_spec :: D.Spec -> Spec
unconvert_spec :: Spec -> Spec
unconvert_spec Spec
sp =
    case Spec
sp of
      D.SP_newtype SpecNewtype
sn -> SpecNewtype -> Spec
SpNewtype forall a b. (a -> b) -> a -> b
$ SpecNewtype -> SpecNewtype
unconvert_specnt SpecNewtype
sn
      D.SP_record  [Field]
sr -> SpecRecord -> Spec
SpRecord  forall a b. (a -> b) -> a -> b
$ [(FieldName, FieldType)] -> SpecRecord
SpecRecord forall a b. (a -> b) -> a -> b
$ [Field] -> [(FieldName, FieldType)]
unconvert_fields [Field]
sr
      D.SP_union   [Field]
su -> SpecUnion -> Spec
SpUnion   forall a b. (a -> b) -> a -> b
$ [(FieldName, (APIType, String))] -> SpecUnion
SpecUnion  forall a b. (a -> b) -> a -> b
$ [Field] -> [(FieldName, (APIType, String))]
unconvert_union [Field]
su
      D.SP_enum    [Text]
se -> SpecEnum -> Spec
SpEnum    forall a b. (a -> b) -> a -> b
$ [(FieldName, String)] -> SpecEnum
SpecEnum   forall a b. (a -> b) -> a -> b
$ [Text] -> [(FieldName, String)]
unconvert_alts   [Text]
se
      D.SP_synonym APIType
ty -> APIType -> Spec
SpSynonym forall a b. (a -> b) -> a -> b
$ APIType -> APIType
unconvert_type   APIType
ty

unconvert_conversion :: D.Conversion -> (FieldName, FieldName)
unconvert_conversion :: Conversion -> (FieldName, FieldName)
unconvert_conversion Conversion
c =
    ( Text -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Conversion -> Text
D._cv_injection  Conversion
c
    , Text -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Conversion -> Text
D._cv_projection Conversion
c
    )

unconvert_specnt :: D.SpecNewtype -> SpecNewtype
unconvert_specnt :: SpecNewtype -> SpecNewtype
unconvert_specnt SpecNewtype
sn =
    SpecNewtype
        { snType :: BasicType
snType   = BasicType -> BasicType
unconvert_basic forall a b. (a -> b) -> a -> b
$    SpecNewtype -> BasicType
D._sn_type   SpecNewtype
sn
        , snFilter :: Maybe Filter
snFilter = Filter -> Filter
unconvert_filter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecNewtype -> Maybe Filter
D._sn_filter SpecNewtype
sn
        }

unconvert_filter :: D.Filter -> Filter
unconvert_filter :: Filter -> Filter
unconvert_filter Filter
ftr =
    case Filter
ftr of
      D.FT_string (D.RegularExpression Text
re_text) -> RegEx -> Filter
FtrStrg forall a b. (a -> b) -> a -> b
$ Text -> Regex -> RegEx
RegEx Text
re_text (String -> Bool -> Bool -> Regex
mkRegexWithOpts (Text -> String
T.unpack Text
re_text) Bool
False Bool
True)
      D.FT_integer (D.IntRange Maybe Int
ir_lo Maybe Int
ir_hi)     -> IntRange -> Filter
FtrIntg forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> IntRange
IntRange Maybe Int
ir_lo Maybe Int
ir_hi
      D.FT_utc (D.UTCRange Maybe UTCTime
ur_lo Maybe UTCTime
ur_hi)         -> UTCRange -> Filter
FtrUTC forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Maybe UTCTime -> UTCRange
UTCRange Maybe UTCTime
ur_lo Maybe UTCTime
ur_hi

unconvert_fields :: [D.Field] -> [(FieldName, FieldType)]
unconvert_fields :: [Field] -> [(FieldName, FieldType)]
unconvert_fields [Field]
al = forall a b. (a -> b) -> [a] -> [b]
map Field -> (FieldName, FieldType)
f [Field]
al
  where
    f :: Field -> (FieldName, FieldType)
f Field
fld = ( Text -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Field -> Text
D._fd_name Field
fld
            , FieldType { ftType :: APIType
ftType     = APIType -> APIType
unconvert_type forall a b. (a -> b) -> a -> b
$ Field -> APIType
D._fd_type Field
fld
                        , ftReadOnly :: Bool
ftReadOnly = Field -> Bool
D._fd_readonly Field
fld
                        , ftDefault :: Maybe DefaultValue
ftDefault  = DefaultValue -> DefaultValue
unconvert_default forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Maybe DefaultValue
D._fd_default Field
fld
                        , ftComment :: String
ftComment  = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Field -> Text
D._fd_comment Field
fld
                        }
            )

unconvert_union :: [D.Field] -> [(FieldName, (APIType, MDComment))]
unconvert_union :: [Field] -> [(FieldName, (APIType, String))]
unconvert_union [Field]
al = forall a b. (a -> b) -> [a] -> [b]
map Field -> (FieldName, (APIType, String))
f [Field]
al
  where
    f :: Field -> (FieldName, (APIType, String))
f Field
fld = ( Text -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Field -> Text
D._fd_name Field
fld
            , ( APIType -> APIType
unconvert_type forall a b. (a -> b) -> a -> b
$ Field -> APIType
D._fd_type Field
fld
              , Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Field -> Text
D._fd_comment Field
fld
            ))

unconvert_alts :: [T.Text] -> [(FieldName,MDComment)]
unconvert_alts :: [Text] -> [(FieldName, String)]
unconvert_alts [Text]
fns = forall a b. (a -> b) -> [a] -> [b]
map ((\FieldName
x -> (FieldName
x, String
"")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FieldName
FieldName) [Text]
fns

unconvert_type :: D.APIType -> APIType
unconvert_type :: APIType -> APIType
unconvert_type APIType
ty0 =
    case APIType
ty0 of
      D.TY_list  APIType
ty   -> APIType -> APIType
TyList  forall a b. (a -> b) -> a -> b
$ APIType -> APIType
unconvert_type  APIType
ty
      D.TY_maybe APIType
ty   -> APIType -> APIType
TyMaybe forall a b. (a -> b) -> a -> b
$ APIType -> APIType
unconvert_type  APIType
ty
      D.TY_ref   TypeRef
r    -> TypeName -> APIType
TyName  forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeName
unconvert_ref TypeRef
r
      D.TY_basic BasicType
bt   -> BasicType -> APIType
TyBasic forall a b. (a -> b) -> a -> b
$ BasicType -> BasicType
unconvert_basic BasicType
bt
      D.TY_json Int
_     -> APIType
TyJSON

unconvert_ref :: D.TypeRef -> TypeName
unconvert_ref :: TypeRef -> TypeName
unconvert_ref (D.TypeRef Text
tn) = Text -> TypeName
TypeName Text
tn

unconvert_basic :: D.BasicType -> BasicType
unconvert_basic :: BasicType -> BasicType
unconvert_basic BasicType
bt =
    case BasicType
bt of
      BasicType
D.BT_string  -> BasicType
BTstring
      BasicType
D.BT_binary  -> BasicType
BTbinary
      BasicType
D.BT_boolean -> BasicType
BTbool
      BasicType
D.BT_integer -> BasicType
BTint
      BasicType
D.BT_utc     -> BasicType
BTutc

unconvert_default :: D.DefaultValue -> DefaultValue
unconvert_default :: DefaultValue -> DefaultValue
unconvert_default (D.DV_list    Int
_) = DefaultValue
DefValList
unconvert_default (D.DV_maybe   Int
_) = DefaultValue
DefValMaybe
unconvert_default (D.DV_string  Text
s) = Text -> DefaultValue
DefValString Text
s
unconvert_default (D.DV_boolean Bool
b) = Bool -> DefaultValue
DefValBool   Bool
b
unconvert_default (D.DV_integer Int
i) = Int -> DefaultValue
DefValInt    Int
i
unconvert_default (D.DV_utc     UTCTime
u) = UTCTime -> DefaultValue
DefValUtc    UTCTime
u