{-# LANGUAGE CPP                        #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

module Data.API.Types
    ( API
    , Thing(..)
    , APINode(..)
    , TypeName(..)
    , FieldName(..)
    , MDComment
    , Prefix
    , Spec(..)
    , SpecNewtype(..)
    , SpecRecord(..)
    , FieldType(..)
    , SpecUnion(..)
    , SpecEnum(..)
    , Conversion
    , APIType(..)
    , DefaultValue(..)
    , BasicType(..)
    , Filter(..)
    , IntRange(..)
    , UTCRange(..)
    , RegEx(..)
    , Binary(..)
    , defaultValueAsJsValue
    , mkRegEx
    , inIntRange
    , inUTCRange
    , base64ToBinary
    ) where

import           Data.API.Time

import           Control.DeepSeq
import qualified Data.CaseInsensitive           as CI
import           Data.String
import           Data.Time
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Aeson.TH
import qualified Codec.Serialise     as CBOR
import           Data.Maybe
import           Data.SafeCopy
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as T
import qualified Data.ByteString.Char8          as B
import           Test.QuickCheck                as QC
import           Control.Applicative
import qualified Data.ByteString.Base64         as B64
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax
import           Text.Regex
import           Prelude


-- | an API spec is made up of a list of type/element specs, each
--   specifying a Haskell type and JSON wrappers

type API = [Thing]

data Thing
    = ThComment MDComment
    | ThNode    APINode
    deriving (Thing -> Thing -> Bool
(Thing -> Thing -> Bool) -> (Thing -> Thing -> Bool) -> Eq Thing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Thing -> Thing -> Bool
== :: Thing -> Thing -> Bool
$c/= :: Thing -> Thing -> Bool
/= :: Thing -> Thing -> Bool
Eq,(forall (m :: * -> *). Quote m => Thing -> m Exp)
-> (forall (m :: * -> *). Quote m => Thing -> Code m Thing)
-> Lift Thing
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Thing -> m Exp
forall (m :: * -> *). Quote m => Thing -> Code m Thing
$clift :: forall (m :: * -> *). Quote m => Thing -> m Exp
lift :: forall (m :: * -> *). Quote m => Thing -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Thing -> Code m Thing
liftTyped :: forall (m :: * -> *). Quote m => Thing -> Code m Thing
Lift,Int -> Thing -> ShowS
[Thing] -> ShowS
Thing -> String
(Int -> Thing -> ShowS)
-> (Thing -> String) -> ([Thing] -> ShowS) -> Show Thing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Thing -> ShowS
showsPrec :: Int -> Thing -> ShowS
$cshow :: Thing -> String
show :: Thing -> String
$cshowList :: [Thing] -> ShowS
showList :: [Thing] -> ShowS
Show)

instance NFData Thing where
  rnf :: Thing -> ()
rnf (ThComment String
x) = String -> ()
forall a. NFData a => a -> ()
rnf String
x
  rnf (ThNode    APINode
x) = APINode -> ()
forall a. NFData a => a -> ()
rnf APINode
x

-- | Specifies an individual element/type of the API

data APINode
    = APINode
        { APINode -> TypeName
anName    :: TypeName         -- ^ name of Haskell type
        , APINode -> String
anComment :: MDComment        -- ^ comment describing type in Markdown
        , APINode -> Prefix
anPrefix  :: Prefix           -- ^ distinct short prefix (see below)
        , APINode -> Spec
anSpec    :: Spec             -- ^ the type specification
        , APINode -> Conversion
anConvert :: Conversion       -- ^ optional conversion functions
        }
    deriving (APINode -> APINode -> Bool
(APINode -> APINode -> Bool)
-> (APINode -> APINode -> Bool) -> Eq APINode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APINode -> APINode -> Bool
== :: APINode -> APINode -> Bool
$c/= :: APINode -> APINode -> Bool
/= :: APINode -> APINode -> Bool
Eq,Int -> APINode -> ShowS
[APINode] -> ShowS
APINode -> String
(Int -> APINode -> ShowS)
-> (APINode -> String) -> ([APINode] -> ShowS) -> Show APINode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APINode -> ShowS
showsPrec :: Int -> APINode -> ShowS
$cshow :: APINode -> String
show :: APINode -> String
$cshowList :: [APINode] -> ShowS
showList :: [APINode] -> ShowS
Show)

instance NFData APINode where
  rnf :: APINode -> ()
rnf (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = TypeName -> ()
forall a. NFData a => a -> ()
rnf TypeName
a () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
b () -> () -> ()
forall a b. a -> b -> b
`seq` Prefix -> ()
forall a. NFData a => a -> ()
rnf Prefix
c () -> () -> ()
forall a b. a -> b -> b
`seq` Spec -> ()
forall a. NFData a => a -> ()
rnf Spec
d () -> () -> ()
forall a b. a -> b -> b
`seq` Conversion -> ()
forall a. NFData a => a -> ()
rnf Conversion
e

-- | TypeName must contain a valid Haskell type constructor
newtype TypeName = TypeName { TypeName -> Text
_TypeName :: T.Text }
    deriving (TypeName -> TypeName -> Bool
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
/= :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
Eq TypeName =>
(TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeName -> TypeName -> Ordering
compare :: TypeName -> TypeName -> Ordering
$c< :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
>= :: TypeName -> TypeName -> Bool
$cmax :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
min :: TypeName -> TypeName -> TypeName
Ord, Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeName -> ShowS
showsPrec :: Int -> TypeName -> ShowS
$cshow :: TypeName -> String
show :: TypeName -> String
$cshowList :: [TypeName] -> ShowS
showList :: [TypeName] -> ShowS
Show, TypeName -> ()
(TypeName -> ()) -> NFData TypeName
forall a. (a -> ()) -> NFData a
$crnf :: TypeName -> ()
rnf :: TypeName -> ()
NFData, String -> TypeName
(String -> TypeName) -> IsString TypeName
forall a. (String -> a) -> IsString a
$cfromString :: String -> TypeName
fromString :: String -> TypeName
IsString)

-- | FieldName identifies recod fields and union alternatives
--   must contain a valid identifier valid in Haskell and
--   any API client wrappers (e.g., if Ruby wrappers are to be
--   generated the names should easily map into Ruby)
newtype FieldName = FieldName { FieldName -> Text
_FieldName :: T.Text }
    deriving (FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
/= :: FieldName -> FieldName -> Bool
Eq, Eq FieldName
Eq FieldName =>
(FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FieldName -> FieldName -> Ordering
compare :: FieldName -> FieldName -> Ordering
$c< :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
>= :: FieldName -> FieldName -> Bool
$cmax :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
min :: FieldName -> FieldName -> FieldName
Ord, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldName -> ShowS
showsPrec :: Int -> FieldName -> ShowS
$cshow :: FieldName -> String
show :: FieldName -> String
$cshowList :: [FieldName] -> ShowS
showList :: [FieldName] -> ShowS
Show, FieldName -> ()
(FieldName -> ()) -> NFData FieldName
forall a. (a -> ()) -> NFData a
$crnf :: FieldName -> ()
rnf :: FieldName -> ()
NFData, String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
$cfromString :: String -> FieldName
fromString :: String -> FieldName
IsString)

-- | Markdown comments are represented by strings

type MDComment = String

-- | a distinct case-insensitive short prefix used to form unique record field
--   names and data constructors:
--
--      * must be a valid Haskell identifier
--
--      * must be unique within the API

type Prefix = CI.CI String

-- | type/element specs are either simple type isomorphisms of basic JSON
--   types, records, unions or enumerated types

data Spec
    = SpNewtype SpecNewtype
    | SpRecord  SpecRecord
    | SpUnion   SpecUnion
    | SpEnum    SpecEnum
    | SpSynonym APIType
    deriving (Spec -> Spec -> Bool
(Spec -> Spec -> Bool) -> (Spec -> Spec -> Bool) -> Eq Spec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Spec -> Spec -> Bool
== :: Spec -> Spec -> Bool
$c/= :: Spec -> Spec -> Bool
/= :: Spec -> Spec -> Bool
Eq,(forall (m :: * -> *). Quote m => Spec -> m Exp)
-> (forall (m :: * -> *). Quote m => Spec -> Code m Spec)
-> Lift Spec
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Spec -> m Exp
forall (m :: * -> *). Quote m => Spec -> Code m Spec
$clift :: forall (m :: * -> *). Quote m => Spec -> m Exp
lift :: forall (m :: * -> *). Quote m => Spec -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Spec -> Code m Spec
liftTyped :: forall (m :: * -> *). Quote m => Spec -> Code m Spec
Lift,Int -> Spec -> ShowS
[Spec] -> ShowS
Spec -> String
(Int -> Spec -> ShowS)
-> (Spec -> String) -> ([Spec] -> ShowS) -> Show Spec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Spec -> ShowS
showsPrec :: Int -> Spec -> ShowS
$cshow :: Spec -> String
show :: Spec -> String
$cshowList :: [Spec] -> ShowS
showList :: [Spec] -> ShowS
Show)

instance NFData Spec where
  rnf :: Spec -> ()
rnf (SpNewtype SpecNewtype
x) = SpecNewtype -> ()
forall a. NFData a => a -> ()
rnf SpecNewtype
x
  rnf (SpRecord  SpecRecord
x) = SpecRecord -> ()
forall a. NFData a => a -> ()
rnf SpecRecord
x
  rnf (SpUnion   SpecUnion
x) = SpecUnion -> ()
forall a. NFData a => a -> ()
rnf SpecUnion
x
  rnf (SpEnum    SpecEnum
x) = SpecEnum -> ()
forall a. NFData a => a -> ()
rnf SpecEnum
x
  rnf (SpSynonym APIType
x) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
x

-- | SpecNewtype elements are isomorphisms of string, inetgers or booleans

data SpecNewtype =
    SpecNewtype
        { SpecNewtype -> BasicType
snType   :: BasicType
        , SpecNewtype -> Maybe Filter
snFilter :: Maybe Filter
        }
    deriving (SpecNewtype -> SpecNewtype -> Bool
(SpecNewtype -> SpecNewtype -> Bool)
-> (SpecNewtype -> SpecNewtype -> Bool) -> Eq SpecNewtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecNewtype -> SpecNewtype -> Bool
== :: SpecNewtype -> SpecNewtype -> Bool
$c/= :: SpecNewtype -> SpecNewtype -> Bool
/= :: SpecNewtype -> SpecNewtype -> Bool
Eq,(forall (m :: * -> *). Quote m => SpecNewtype -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SpecNewtype -> Code m SpecNewtype)
-> Lift SpecNewtype
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
$clift :: forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
lift :: forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
liftTyped :: forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
Lift,Int -> SpecNewtype -> ShowS
[SpecNewtype] -> ShowS
SpecNewtype -> String
(Int -> SpecNewtype -> ShowS)
-> (SpecNewtype -> String)
-> ([SpecNewtype] -> ShowS)
-> Show SpecNewtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecNewtype -> ShowS
showsPrec :: Int -> SpecNewtype -> ShowS
$cshow :: SpecNewtype -> String
show :: SpecNewtype -> String
$cshowList :: [SpecNewtype] -> ShowS
showList :: [SpecNewtype] -> ShowS
Show)

instance NFData SpecNewtype where
  rnf :: SpecNewtype -> ()
rnf (SpecNewtype BasicType
x Maybe Filter
y) = BasicType -> ()
forall a. NFData a => a -> ()
rnf BasicType
x () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Filter -> ()
forall a. NFData a => a -> ()
rnf Maybe Filter
y

data Filter
    = FtrStrg RegEx
    | FtrIntg IntRange
    | FtrUTC  UTCRange
    deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
/= :: Filter -> Filter -> Bool
Eq,(forall (m :: * -> *). Quote m => Filter -> m Exp)
-> (forall (m :: * -> *). Quote m => Filter -> Code m Filter)
-> Lift Filter
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Filter -> m Exp
forall (m :: * -> *). Quote m => Filter -> Code m Filter
$clift :: forall (m :: * -> *). Quote m => Filter -> m Exp
lift :: forall (m :: * -> *). Quote m => Filter -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Filter -> Code m Filter
liftTyped :: forall (m :: * -> *). Quote m => Filter -> Code m Filter
Lift,Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show)

instance NFData Filter where
  rnf :: Filter -> ()
rnf (FtrStrg RegEx
x) = RegEx -> ()
forall a. NFData a => a -> ()
rnf RegEx
x
  rnf (FtrIntg IntRange
x) = IntRange -> ()
forall a. NFData a => a -> ()
rnf IntRange
x
  rnf (FtrUTC  UTCRange
x) = UTCRange -> ()
forall a. NFData a => a -> ()
rnf UTCRange
x

data IntRange
    = IntRange
        { IntRange -> Maybe Int
ir_lo :: Maybe Int
        , IntRange -> Maybe Int
ir_hi :: Maybe Int
        }
    deriving (IntRange -> IntRange -> Bool
(IntRange -> IntRange -> Bool)
-> (IntRange -> IntRange -> Bool) -> Eq IntRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntRange -> IntRange -> Bool
== :: IntRange -> IntRange -> Bool
$c/= :: IntRange -> IntRange -> Bool
/= :: IntRange -> IntRange -> Bool
Eq, (forall (m :: * -> *). Quote m => IntRange -> m Exp)
-> (forall (m :: * -> *). Quote m => IntRange -> Code m IntRange)
-> Lift IntRange
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => IntRange -> m Exp
forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
$clift :: forall (m :: * -> *). Quote m => IntRange -> m Exp
lift :: forall (m :: * -> *). Quote m => IntRange -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
liftTyped :: forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
Lift, Int -> IntRange -> ShowS
[IntRange] -> ShowS
IntRange -> String
(Int -> IntRange -> ShowS)
-> (IntRange -> String) -> ([IntRange] -> ShowS) -> Show IntRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntRange -> ShowS
showsPrec :: Int -> IntRange -> ShowS
$cshow :: IntRange -> String
show :: IntRange -> String
$cshowList :: [IntRange] -> ShowS
showList :: [IntRange] -> ShowS
Show)

instance NFData IntRange where
  rnf :: IntRange -> ()
rnf (IntRange Maybe Int
x Maybe Int
y) = Maybe Int -> ()
forall a. NFData a => a -> ()
rnf Maybe Int
x () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Int -> ()
forall a. NFData a => a -> ()
rnf Maybe Int
y

inIntRange :: Int -> IntRange -> Bool
Int
_ inIntRange :: Int -> IntRange -> Bool
`inIntRange` IntRange Maybe Int
Nothing   Maybe Int
Nothing   = Bool
True
Int
i `inIntRange` IntRange (Just Int
lo) Maybe Int
Nothing   = Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
Int
i `inIntRange` IntRange Maybe Int
Nothing   (Just Int
hi) = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi
Int
i `inIntRange` IntRange (Just Int
lo) (Just Int
hi) = Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi

data UTCRange
    = UTCRange
        { UTCRange -> Maybe UTCTime
ur_lo :: Maybe UTCTime
        , UTCRange -> Maybe UTCTime
ur_hi :: Maybe UTCTime
        }
    deriving (UTCRange -> UTCRange -> Bool
(UTCRange -> UTCRange -> Bool)
-> (UTCRange -> UTCRange -> Bool) -> Eq UTCRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTCRange -> UTCRange -> Bool
== :: UTCRange -> UTCRange -> Bool
$c/= :: UTCRange -> UTCRange -> Bool
/= :: UTCRange -> UTCRange -> Bool
Eq, Int -> UTCRange -> ShowS
[UTCRange] -> ShowS
UTCRange -> String
(Int -> UTCRange -> ShowS)
-> (UTCRange -> String) -> ([UTCRange] -> ShowS) -> Show UTCRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTCRange -> ShowS
showsPrec :: Int -> UTCRange -> ShowS
$cshow :: UTCRange -> String
show :: UTCRange -> String
$cshowList :: [UTCRange] -> ShowS
showList :: [UTCRange] -> ShowS
Show)

instance NFData UTCRange where
  rnf :: UTCRange -> ()
rnf (UTCRange Maybe UTCTime
x Maybe UTCTime
y) = Maybe UTCTime -> ()
forall a. NFData a => a -> ()
rnf Maybe UTCTime
x () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe UTCTime -> ()
forall a. NFData a => a -> ()
rnf Maybe UTCTime
y

inUTCRange :: UTCTime -> UTCRange -> Bool
UTCTime
_ inUTCRange :: UTCTime -> UTCRange -> Bool
`inUTCRange` UTCRange Maybe UTCTime
Nothing   Maybe UTCTime
Nothing   = Bool
True
UTCTime
u `inUTCRange` UTCRange (Just UTCTime
lo) Maybe UTCTime
Nothing   = UTCTime
lo UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
u
UTCTime
u `inUTCRange` UTCRange Maybe UTCTime
Nothing   (Just UTCTime
hi) = UTCTime
u UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
hi
UTCTime
u `inUTCRange` UTCRange (Just UTCTime
lo) (Just UTCTime
hi) = UTCTime
lo UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
u Bool -> Bool -> Bool
&& UTCTime
u UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
hi


data RegEx =
    RegEx
        { RegEx -> Text
re_text  :: T.Text
        , RegEx -> Regex
re_regex :: Regex
        }

mkRegEx :: T.Text -> RegEx
mkRegEx :: Text -> RegEx
mkRegEx Text
txt = Text -> Regex -> RegEx
RegEx Text
txt (Regex -> RegEx) -> Regex -> RegEx
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Bool -> Regex
mkRegexWithOpts (Text -> String
T.unpack Text
txt) Bool
False Bool
True

instance NFData RegEx where
  rnf :: RegEx -> ()
rnf (RegEx Text
x !Regex
_) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
x

instance ToJSON RegEx where
    toJSON :: RegEx -> Value
toJSON RegEx{Text
Regex
re_text :: RegEx -> Text
re_regex :: RegEx -> Regex
re_text :: Text
re_regex :: Regex
..} = Text -> Value
String Text
re_text

instance FromJSON RegEx where
    parseJSON :: Value -> Parser RegEx
parseJSON = String -> (Text -> Parser RegEx) -> Value -> Parser RegEx
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegEx" (RegEx -> Parser RegEx
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegEx -> Parser RegEx) -> (Text -> RegEx) -> Text -> Parser RegEx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegEx
mkRegEx)

instance Eq RegEx where
    RegEx
r == :: RegEx -> RegEx -> Bool
== RegEx
s = RegEx -> Text
re_text RegEx
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== RegEx -> Text
re_text RegEx
s

instance Show RegEx where
    show :: RegEx -> String
show = Text -> String
T.unpack (Text -> String) -> (RegEx -> Text) -> RegEx -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegEx -> Text
re_text

-- | SpecRecord is your classsic product type.

data SpecRecord = SpecRecord
    { SpecRecord -> [(FieldName, FieldType)]
srFields :: [(FieldName, FieldType)]
    }
    deriving (SpecRecord -> SpecRecord -> Bool
(SpecRecord -> SpecRecord -> Bool)
-> (SpecRecord -> SpecRecord -> Bool) -> Eq SpecRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecRecord -> SpecRecord -> Bool
== :: SpecRecord -> SpecRecord -> Bool
$c/= :: SpecRecord -> SpecRecord -> Bool
/= :: SpecRecord -> SpecRecord -> Bool
Eq,(forall (m :: * -> *). Quote m => SpecRecord -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SpecRecord -> Code m SpecRecord)
-> Lift SpecRecord
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecRecord -> m Exp
forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
$clift :: forall (m :: * -> *). Quote m => SpecRecord -> m Exp
lift :: forall (m :: * -> *). Quote m => SpecRecord -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
liftTyped :: forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
Lift,Int -> SpecRecord -> ShowS
[SpecRecord] -> ShowS
SpecRecord -> String
(Int -> SpecRecord -> ShowS)
-> (SpecRecord -> String)
-> ([SpecRecord] -> ShowS)
-> Show SpecRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecRecord -> ShowS
showsPrec :: Int -> SpecRecord -> ShowS
$cshow :: SpecRecord -> String
show :: SpecRecord -> String
$cshowList :: [SpecRecord] -> ShowS
showList :: [SpecRecord] -> ShowS
Show)

instance NFData SpecRecord where
  rnf :: SpecRecord -> ()
rnf (SpecRecord [(FieldName, FieldType)]
x) = [(FieldName, FieldType)] -> ()
forall a. NFData a => a -> ()
rnf [(FieldName, FieldType)]
x

-- | In addition to the type and comment, record fields may carry a
-- flag indicating that they are read-only, and may have a default
-- value, which must be of a compatible type.

data FieldType = FieldType
    { FieldType -> APIType
ftType     :: APIType
    , FieldType -> Bool
ftReadOnly :: Bool
    , FieldType -> Maybe DefaultValue
ftDefault  :: Maybe DefaultValue
    , FieldType -> String
ftComment  :: MDComment
    }
    deriving (FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
/= :: FieldType -> FieldType -> Bool
Eq,(forall (m :: * -> *). Quote m => FieldType -> m Exp)
-> (forall (m :: * -> *). Quote m => FieldType -> Code m FieldType)
-> Lift FieldType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FieldType -> m Exp
forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
$clift :: forall (m :: * -> *). Quote m => FieldType -> m Exp
lift :: forall (m :: * -> *). Quote m => FieldType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
liftTyped :: forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
Lift,Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldType -> ShowS
showsPrec :: Int -> FieldType -> ShowS
$cshow :: FieldType -> String
show :: FieldType -> String
$cshowList :: [FieldType] -> ShowS
showList :: [FieldType] -> ShowS
Show)

instance NFData FieldType where
  rnf :: FieldType -> ()
rnf (FieldType APIType
a Bool
b Maybe DefaultValue
c String
d) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
a () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe DefaultValue -> ()
forall a. NFData a => a -> ()
rnf Maybe DefaultValue
c () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
d

-- | SpecUnion is your classsic union type

data SpecUnion = SpecUnion
    { SpecUnion -> [(FieldName, (APIType, String))]
suFields :: [(FieldName,(APIType,MDComment))]
    }
    deriving (SpecUnion -> SpecUnion -> Bool
(SpecUnion -> SpecUnion -> Bool)
-> (SpecUnion -> SpecUnion -> Bool) -> Eq SpecUnion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecUnion -> SpecUnion -> Bool
== :: SpecUnion -> SpecUnion -> Bool
$c/= :: SpecUnion -> SpecUnion -> Bool
/= :: SpecUnion -> SpecUnion -> Bool
Eq,(forall (m :: * -> *). Quote m => SpecUnion -> m Exp)
-> (forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion)
-> Lift SpecUnion
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecUnion -> m Exp
forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
$clift :: forall (m :: * -> *). Quote m => SpecUnion -> m Exp
lift :: forall (m :: * -> *). Quote m => SpecUnion -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
liftTyped :: forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
Lift,Int -> SpecUnion -> ShowS
[SpecUnion] -> ShowS
SpecUnion -> String
(Int -> SpecUnion -> ShowS)
-> (SpecUnion -> String)
-> ([SpecUnion] -> ShowS)
-> Show SpecUnion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecUnion -> ShowS
showsPrec :: Int -> SpecUnion -> ShowS
$cshow :: SpecUnion -> String
show :: SpecUnion -> String
$cshowList :: [SpecUnion] -> ShowS
showList :: [SpecUnion] -> ShowS
Show)

instance NFData SpecUnion where
  rnf :: SpecUnion -> ()
rnf (SpecUnion [(FieldName, (APIType, String))]
x) = [(FieldName, (APIType, String))] -> ()
forall a. NFData a => a -> ()
rnf [(FieldName, (APIType, String))]
x

-- | SpecEnum is your classic enumerated type

data SpecEnum = SpecEnum
    { SpecEnum -> [(FieldName, String)]
seAlts :: [(FieldName,MDComment)]
    }
    deriving (SpecEnum -> SpecEnum -> Bool
(SpecEnum -> SpecEnum -> Bool)
-> (SpecEnum -> SpecEnum -> Bool) -> Eq SpecEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecEnum -> SpecEnum -> Bool
== :: SpecEnum -> SpecEnum -> Bool
$c/= :: SpecEnum -> SpecEnum -> Bool
/= :: SpecEnum -> SpecEnum -> Bool
Eq,(forall (m :: * -> *). Quote m => SpecEnum -> m Exp)
-> (forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum)
-> Lift SpecEnum
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecEnum -> m Exp
forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
$clift :: forall (m :: * -> *). Quote m => SpecEnum -> m Exp
lift :: forall (m :: * -> *). Quote m => SpecEnum -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
liftTyped :: forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
Lift,Int -> SpecEnum -> ShowS
[SpecEnum] -> ShowS
SpecEnum -> String
(Int -> SpecEnum -> ShowS)
-> (SpecEnum -> String) -> ([SpecEnum] -> ShowS) -> Show SpecEnum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecEnum -> ShowS
showsPrec :: Int -> SpecEnum -> ShowS
$cshow :: SpecEnum -> String
show :: SpecEnum -> String
$cshowList :: [SpecEnum] -> ShowS
showList :: [SpecEnum] -> ShowS
Show)

instance NFData SpecEnum where
  rnf :: SpecEnum -> ()
rnf (SpecEnum [(FieldName, String)]
x) = [(FieldName, String)] -> ()
forall a. NFData a => a -> ()
rnf [(FieldName, String)]
x

-- | Conversion possibly converts to an internal representation.  If
-- specified, a conversion is a pair of an injection function name and
-- a projection function name.
type Conversion = Maybe (FieldName,FieldName)

-- | Type is either a list, Maybe, a named element of the API or a basic type
data APIType
    = TyList  APIType       -- ^ list elements are types
    | TyMaybe APIType       -- ^ Maybe elements are types
    | TyName  TypeName      -- ^ the referenced type must be defined by the API
    | TyBasic BasicType     -- ^ a JSON string, int, bool etc.
    | TyJSON                -- ^ a generic JSON value
    deriving (APIType -> APIType -> Bool
(APIType -> APIType -> Bool)
-> (APIType -> APIType -> Bool) -> Eq APIType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIType -> APIType -> Bool
== :: APIType -> APIType -> Bool
$c/= :: APIType -> APIType -> Bool
/= :: APIType -> APIType -> Bool
Eq, (forall (m :: * -> *). Quote m => APIType -> m Exp)
-> (forall (m :: * -> *). Quote m => APIType -> Code m APIType)
-> Lift APIType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => APIType -> m Exp
forall (m :: * -> *). Quote m => APIType -> Code m APIType
$clift :: forall (m :: * -> *). Quote m => APIType -> m Exp
lift :: forall (m :: * -> *). Quote m => APIType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => APIType -> Code m APIType
liftTyped :: forall (m :: * -> *). Quote m => APIType -> Code m APIType
Lift, Int -> APIType -> ShowS
[APIType] -> ShowS
APIType -> String
(Int -> APIType -> ShowS)
-> (APIType -> String) -> ([APIType] -> ShowS) -> Show APIType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIType -> ShowS
showsPrec :: Int -> APIType -> ShowS
$cshow :: APIType -> String
show :: APIType -> String
$cshowList :: [APIType] -> ShowS
showList :: [APIType] -> ShowS
Show)

-- | It is sometimes helpful to write a type name directly as a string
instance IsString APIType where
  fromString :: String -> APIType
fromString = TypeName -> APIType
TyName (TypeName -> APIType) -> (String -> TypeName) -> String -> APIType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TypeName
forall a. IsString a => String -> a
fromString

instance NFData APIType where
  rnf :: APIType -> ()
rnf (TyList  APIType
ty) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyMaybe APIType
ty) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyName  TypeName
tn) = TypeName -> ()
forall a. NFData a => a -> ()
rnf TypeName
tn
  rnf (TyBasic BasicType
bt) = BasicType -> ()
forall a. NFData a => a -> ()
rnf BasicType
bt
  rnf APIType
TyJSON       = ()

-- | the basic JSON types (N.B., no floating point numbers, yet)
data BasicType
    = BTstring -- ^ a JSON UTF-8 string
    | BTbinary -- ^ a base-64-encoded byte string
    | BTbool   -- ^ a JSON bool
    | BTint    -- ^ a JSON integral number
    | BTutc    -- ^ a JSON UTC string
    deriving (BasicType -> BasicType -> Bool
(BasicType -> BasicType -> Bool)
-> (BasicType -> BasicType -> Bool) -> Eq BasicType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BasicType -> BasicType -> Bool
== :: BasicType -> BasicType -> Bool
$c/= :: BasicType -> BasicType -> Bool
/= :: BasicType -> BasicType -> Bool
Eq, (forall (m :: * -> *). Quote m => BasicType -> m Exp)
-> (forall (m :: * -> *). Quote m => BasicType -> Code m BasicType)
-> Lift BasicType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => BasicType -> m Exp
forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
$clift :: forall (m :: * -> *). Quote m => BasicType -> m Exp
lift :: forall (m :: * -> *). Quote m => BasicType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
liftTyped :: forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
Lift, Int -> BasicType -> ShowS
[BasicType] -> ShowS
BasicType -> String
(Int -> BasicType -> ShowS)
-> (BasicType -> String)
-> ([BasicType] -> ShowS)
-> Show BasicType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BasicType -> ShowS
showsPrec :: Int -> BasicType -> ShowS
$cshow :: BasicType -> String
show :: BasicType -> String
$cshowList :: [BasicType] -> ShowS
showList :: [BasicType] -> ShowS
Show)

instance NFData BasicType where
  rnf :: BasicType -> ()
rnf !BasicType
_ = ()

-- | A default value for a field
data DefaultValue
    = DefValList
    | DefValMaybe
    | DefValString T.Text  -- used for binary fields (base64 encoded)
    | DefValBool   Bool
    | DefValInt    Int
    | DefValUtc    UTCTime
    deriving (DefaultValue -> DefaultValue -> Bool
(DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool) -> Eq DefaultValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultValue -> DefaultValue -> Bool
== :: DefaultValue -> DefaultValue -> Bool
$c/= :: DefaultValue -> DefaultValue -> Bool
/= :: DefaultValue -> DefaultValue -> Bool
Eq, Int -> DefaultValue -> ShowS
[DefaultValue] -> ShowS
DefaultValue -> String
(Int -> DefaultValue -> ShowS)
-> (DefaultValue -> String)
-> ([DefaultValue] -> ShowS)
-> Show DefaultValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultValue -> ShowS
showsPrec :: Int -> DefaultValue -> ShowS
$cshow :: DefaultValue -> String
show :: DefaultValue -> String
$cshowList :: [DefaultValue] -> ShowS
showList :: [DefaultValue] -> ShowS
Show)

instance NFData DefaultValue where
  rnf :: DefaultValue -> ()
rnf DefaultValue
DefValList       = ()
  rnf DefaultValue
DefValMaybe      = ()
  rnf (DefValString Text
t) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t
  rnf (DefValBool   Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
  rnf (DefValInt    Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf (DefValUtc    UTCTime
u) = UTCTime -> ()
forall a. NFData a => a -> ()
rnf UTCTime
u

-- | Convert a default value to an Aeson 'Value'.  This differs from
-- 'toJSON' as it will not round-trip with 'fromJSON': UTC default
-- values are turned into strings.
defaultValueAsJsValue :: DefaultValue -> Value
defaultValueAsJsValue :: DefaultValue -> Value
defaultValueAsJsValue  DefaultValue
DefValList                = [()] -> Value
forall a. ToJSON a => a -> Value
toJSON ([] :: [()])
defaultValueAsJsValue  DefaultValue
DefValMaybe               = Value
Null
defaultValueAsJsValue (DefValString Text
s)           = Text -> Value
String Text
s
defaultValueAsJsValue (DefValBool   Bool
b)           = Bool -> Value
Bool Bool
b
defaultValueAsJsValue (DefValInt    Int
n)           = Scientific -> Value
Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
defaultValueAsJsValue (DefValUtc    UTCTime
t)           = Text -> Value
String (UTCTime -> Text
printUTC UTCTime
t)


-- | Binary data is represented in JSON format as a base64-encoded
-- string
newtype Binary = Binary { Binary -> ByteString
_Binary :: B.ByteString }
    deriving (Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binary -> ShowS
showsPrec :: Int -> Binary -> ShowS
$cshow :: Binary -> String
show :: Binary -> String
$cshowList :: [Binary] -> ShowS
showList :: [Binary] -> ShowS
Show,Binary -> Binary -> Bool
(Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool) -> Eq Binary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binary -> Binary -> Bool
== :: Binary -> Binary -> Bool
$c/= :: Binary -> Binary -> Bool
/= :: Binary -> Binary -> Bool
Eq,Eq Binary
Eq Binary =>
(Binary -> Binary -> Ordering)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Binary)
-> (Binary -> Binary -> Binary)
-> Ord Binary
Binary -> Binary -> Bool
Binary -> Binary -> Ordering
Binary -> Binary -> Binary
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Binary -> Binary -> Ordering
compare :: Binary -> Binary -> Ordering
$c< :: Binary -> Binary -> Bool
< :: Binary -> Binary -> Bool
$c<= :: Binary -> Binary -> Bool
<= :: Binary -> Binary -> Bool
$c> :: Binary -> Binary -> Bool
> :: Binary -> Binary -> Bool
$c>= :: Binary -> Binary -> Bool
>= :: Binary -> Binary -> Bool
$cmax :: Binary -> Binary -> Binary
max :: Binary -> Binary -> Binary
$cmin :: Binary -> Binary -> Binary
min :: Binary -> Binary -> Binary
Ord,Binary -> ()
(Binary -> ()) -> NFData Binary
forall a. (a -> ()) -> NFData a
$crnf :: Binary -> ()
rnf :: Binary -> ()
NFData,[Binary] -> Encoding
Binary -> Encoding
(Binary -> Encoding)
-> (forall s. Decoder s Binary)
-> ([Binary] -> Encoding)
-> (forall s. Decoder s [Binary])
-> Serialise Binary
forall s. Decoder s [Binary]
forall s. Decoder s Binary
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Binary -> Encoding
encode :: Binary -> Encoding
$cdecode :: forall s. Decoder s Binary
decode :: forall s. Decoder s Binary
$cencodeList :: [Binary] -> Encoding
encodeList :: [Binary] -> Encoding
$cdecodeList :: forall s. Decoder s [Binary]
decodeList :: forall s. Decoder s [Binary]
CBOR.Serialise)

instance ToJSON Binary where
    toJSON :: Binary -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Binary -> Text) -> Binary -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (Binary -> ByteString) -> Binary -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (Binary -> ByteString) -> Binary -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary

instance FromJSON Binary where
    parseJSON :: Value -> Parser Binary
parseJSON = String -> (Binary -> Parser Binary) -> Value -> Parser Binary
forall a. String -> (Binary -> Parser a) -> Value -> Parser a
withBinary String
"Binary" Binary -> Parser Binary
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance QC.Arbitrary T.Text where
    arbitrary :: Gen Text
arbitrary = String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary

instance QC.Arbitrary Binary where
    arbitrary :: Gen Binary
arbitrary = ByteString -> Binary
Binary (ByteString -> Binary)
-> (String -> ByteString) -> String -> Binary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString
B.pack (String -> Binary) -> Gen String -> Gen Binary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary

withBinary :: String -> (Binary->Parser a) -> Value -> Parser a
withBinary :: forall a. String -> (Binary -> Parser a) -> Value -> Parser a
withBinary String
lab Binary -> Parser a
f = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
lab Text -> Parser a
g
  where
    g :: Text -> Parser a
g Text
t =
        case Text -> Either String Binary
base64ToBinary Text
t of
          Left  String
_  -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
lab (Text -> Value
String Text
t)
          Right Binary
bs -> Binary -> Parser a
f Binary
bs

base64ToBinary :: T.Text -> Either String Binary
base64ToBinary :: Text -> Either String Binary
base64ToBinary Text
t = ByteString -> Binary
Binary (ByteString -> Binary)
-> Either String ByteString -> Either String Binary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
B64.decode (Text -> ByteString
T.encodeUtf8 Text
t)


instance Lift APINode where
  lift :: forall (m :: * -> *). Quote m => APINode -> m Exp
lift (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = [e| APINode a b $(Prefix -> m Exp
forall (m :: * -> *). Quote m => Prefix -> m Exp
liftPrefix Prefix
c) d e |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => APINode -> Code m APINode
liftTyped (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = [e|| TypeName -> String -> Prefix -> Spec -> Conversion -> APINode
APINode TypeName
a String
b $$(Prefix -> Code m Prefix
forall (m :: * -> *). Quote m => Prefix -> Code m Prefix
liftTypedPrefix Prefix
c) Spec
d Conversion
e ||]
#endif


#if MIN_VERSION_template_haskell(2,17,0)
liftPrefix :: Quote m => Prefix -> m Exp
liftText :: Quote m => T.Text -> m Exp
liftUTC :: Quote m => UTCTime -> m Exp
liftMaybeUTCTime :: Quote m => Maybe UTCTime -> m Exp
#else
liftPrefix :: Prefix -> ExpQ
liftText :: T.Text -> ExpQ
liftUTC :: UTCTime -> ExpQ
liftMaybeUTCTime :: Maybe UTCTime -> ExpQ
#endif

liftPrefix :: forall (m :: * -> *). Quote m => Prefix -> m Exp
liftPrefix Prefix
ci = let s :: String
s = Prefix -> String
forall s. CI s -> s
CI.original Prefix
ci in [e| CI.mk s |]

liftText :: forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
s = [e| T.pack $(Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL (Text -> String
T.unpack Text
s))) |]

liftUTC :: forall (m :: * -> *). Quote m => UTCTime -> m Exp
liftUTC UTCTime
u = [e| unsafeParseUTC $(Text -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
liftText (UTCTime -> Text
printUTC UTCTime
u)) |]

liftMaybeUTCTime :: forall (m :: * -> *). Quote m => Maybe UTCTime -> m Exp
liftMaybeUTCTime Maybe UTCTime
Nothing  = [e| Nothing |]
liftMaybeUTCTime (Just UTCTime
u) = [e| Just $(UTCTime -> m Exp
forall (m :: * -> *). Quote m => UTCTime -> m Exp
liftUTC UTCTime
u) |]



#if MIN_VERSION_template_haskell(2,17,0)
liftTypedPrefix :: Quote m => Prefix -> Code m Prefix
liftTypedPrefix :: forall (m :: * -> *). Quote m => Prefix -> Code m Prefix
liftTypedPrefix Prefix
ci = let s :: String
s = Prefix -> String
forall s. CI s -> s
CI.original Prefix
ci in [e|| s -> CI s
forall s. FoldCase s => s -> CI s
CI.mk String
s ||]

liftTypedText :: Quote m => T.Text -> Code m T.Text
liftTypedText :: forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText Text
s = [e|| String -> Text
T.pack $$(String -> Code m String
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => String -> Code m String
liftTyped (Text -> String
T.unpack Text
s)) ||]

liftTypedUTC :: Quote m => UTCTime -> Code m UTCTime
liftTypedUTC :: forall (m :: * -> *). Quote m => UTCTime -> Code m UTCTime
liftTypedUTC UTCTime
u = [e|| HasCallStack => Text -> UTCTime
Text -> UTCTime
unsafeParseUTC $$(Text -> Code m Text
forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText (UTCTime -> Text
printUTC UTCTime
u)) ||]

liftTypedMaybeUTCTime :: Quote m => Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime :: forall (m :: * -> *).
Quote m =>
Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime Maybe UTCTime
Nothing  = [e|| Maybe a
forall a. Maybe a
Nothing ||]
liftTypedMaybeUTCTime (Just UTCTime
u) = [e|| a -> Maybe a
forall a. a -> Maybe a
Just $$(UTCTime -> Code m UTCTime
forall (m :: * -> *). Quote m => UTCTime -> Code m UTCTime
liftTypedUTC UTCTime
u) ||]
#elif MIN_VERSION_template_haskell(2,16,0)
liftTypedPrefix :: Prefix -> TExpQ Prefix
liftTypedPrefix ci = let s = CI.original ci in [e|| CI.mk s ||]

liftTypedText :: T.Text -> TExpQ T.Text
liftTypedText s = [e|| T.pack $$(liftTyped (T.unpack s)) ||]

liftTypedUTC :: UTCTime -> TExpQ UTCTime
liftTypedUTC u = [e|| unsafeParseUTC $$(liftTypedText (printUTC u)) ||]

liftTypedMaybeUTCTime :: Maybe UTCTime -> TExpQ (Maybe UTCTime)
liftTypedMaybeUTCTime Nothing  = [e|| Nothing ||]
liftTypedMaybeUTCTime (Just u) = [e|| Just $$(liftTypedUTC u) ||]
#endif

instance Lift TypeName where
  lift :: forall (m :: * -> *). Quote m => TypeName -> m Exp
lift (TypeName Text
s) = [e| TypeName $(Text -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => TypeName -> Code m TypeName
liftTyped (TypeName Text
s) = [e|| Text -> TypeName
TypeName $$(Text -> Code m Text
forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText Text
s) ||]
#endif

instance Lift FieldName where
  lift :: forall (m :: * -> *). Quote m => FieldName -> m Exp
lift (FieldName Text
s) = [e| FieldName $(Text -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => FieldName -> Code m FieldName
liftTyped (FieldName Text
s) = [e|| Text -> FieldName
FieldName $$(Text -> Code m Text
forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText Text
s) ||]
#endif

instance Lift UTCRange where
  lift :: forall (m :: * -> *). Quote m => UTCRange -> m Exp
lift (UTCRange Maybe UTCTime
lo Maybe UTCTime
hi) = [e| UTCRange $(Maybe UTCTime -> m Exp
forall (m :: * -> *). Quote m => Maybe UTCTime -> m Exp
liftMaybeUTCTime Maybe UTCTime
lo) $(Maybe UTCTime -> m Exp
forall (m :: * -> *). Quote m => Maybe UTCTime -> m Exp
liftMaybeUTCTime Maybe UTCTime
hi) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => UTCRange -> Code m UTCRange
liftTyped (UTCRange Maybe UTCTime
lo Maybe UTCTime
hi) = [e|| Maybe UTCTime -> Maybe UTCTime -> UTCRange
UTCRange $$(Maybe UTCTime -> Code m (Maybe UTCTime)
forall (m :: * -> *).
Quote m =>
Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime Maybe UTCTime
lo) $$(Maybe UTCTime -> Code m (Maybe UTCTime)
forall (m :: * -> *).
Quote m =>
Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime Maybe UTCTime
hi) ||]
#endif

instance Lift RegEx where
  lift :: forall (m :: * -> *). Quote m => RegEx -> m Exp
lift RegEx
re = [e| mkRegEx $(Text -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
liftText (RegEx -> Text
re_text RegEx
re)) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => RegEx -> Code m RegEx
liftTyped RegEx
re = [e|| Text -> RegEx
mkRegEx $$(Text -> Code m Text
forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText (RegEx -> Text
re_text RegEx
re)) ||]
#endif

instance Lift DefaultValue where
  lift :: forall (m :: * -> *). Quote m => DefaultValue -> m Exp
lift DefaultValue
DefValList       = [e| DefValList |]
  lift DefaultValue
DefValMaybe      = [e| DefValMaybe |]
  lift (DefValString Text
s) = [e| DefValString $(Text -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
s) |]
  lift (DefValBool   Bool
b) = [e| DefValBool b |]
  lift (DefValInt    Int
i) = [e| DefValInt i |]
  lift (DefValUtc    UTCTime
u) = [e| DefValUtc $(UTCTime -> m Exp
forall (m :: * -> *). Quote m => UTCTime -> m Exp
liftUTC UTCTime
u) |]

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
DefaultValue -> Code m DefaultValue
liftTyped DefaultValue
DefValList       = [e|| DefaultValue
DefValList ||]
  liftTyped DefaultValue
DefValMaybe      = [e|| DefaultValue
DefValMaybe ||]
  liftTyped (DefValString Text
s) = [e|| Text -> DefaultValue
DefValString $$(Text -> Code m Text
forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText Text
s) ||]
  liftTyped (DefValBool   Bool
b) = [e|| Bool -> DefaultValue
DefValBool Bool
b ||]
  liftTyped (DefValInt    Int
i) = [e|| Int -> DefaultValue
DefValInt Int
i ||]
  liftTyped (DefValUtc    UTCTime
u) = [e|| UTCTime -> DefaultValue
DefValUtc $$(UTCTime -> Code m UTCTime
forall (m :: * -> *). Quote m => UTCTime -> Code m UTCTime
liftTypedUTC UTCTime
u) ||]
#endif

$(deriveSafeCopy 0 'base ''Binary)

$(let deriveJSONs = fmap concat . mapM (deriveJSON defaultOptions)
  in deriveJSONs [ ''CI.CI
                 , ''TypeName
                 , ''FieldName
                 , ''DefaultValue
                 , ''SpecEnum
                 , ''SpecUnion
                 , ''SpecRecord
                 , ''FieldType
                 , ''SpecNewtype
                 , ''Filter
                 , ''IntRange
                 , ''UTCRange
                 , ''BasicType
                 , ''APIType
                 , ''Spec
                 , ''APINode
                 , ''Thing
                 ])