content: {-# LANGUAGE
      DataKinds
    , GADTs
    , ScopedTypeVariables
    , TypeFamilies
    #-}
  module Rest.Container
    ( module Rest.Types.Container
    , listI
    , listO
    , mappingI
    , mappingO
    , statusO
    , reasonE
    , defaultE
    ) where
  
  import Data.Maybe
  
  import Rest.Dictionary
  import Rest.Error
  import Rest.StringMap.HashMap.Strict
  import Rest.Types.Container
  import Rest.Types.Void
  
  listI :: Inputs i -> Maybe (Inputs ('Just (List (FromMaybe () i))))
  listI None       = Just (Dicts [XmlI, JsonI])
  listI (Dicts is) =
    case mapMaybe listDictI is of
      []  -> Nothing
      lis -> Just (Dicts lis)
    where
      listDictI :: Input a -> Maybe (Input (List a))
      listDictI XmlI  = Just XmlI
      listDictI JsonI = Just JsonI
      listDictI _     = Nothing
  
  listO :: Outputs o -> Maybe (Outputs ('Just (List (FromMaybe () o))))
  listO None       = Just (Dicts [XmlO, JsonO])
  listO (Dicts os) =
    case mapMaybe listDictO os of
      []  -> Nothing
      los -> Just (Dicts los)
    where
      listDictO :: Output a -> Maybe (Output (List a))
      listDictO XmlO  = Just XmlO
      listDictO JsonO = Just JsonO
      listDictO _     = Nothing
  
  mappingI :: forall i i'. i ~ FromMaybe () i' => Inputs i' -> Maybe (Inputs ('Just (StringHashMap String i)))
  mappingI None       = Just (Dicts [XmlI, JsonI])
  mappingI (Dicts is) =
    case mapMaybe mappingDictI is of
      []  -> Nothing
      mis -> Just (Dicts mis)
    where
      mappingDictI :: Input i -> Maybe (Input (StringHashMap String i))
      mappingDictI XmlI  = Just XmlI
      mappingDictI JsonI = Just JsonI
      mappingDictI _     = Nothing
  
  mappingO :: forall o o'. o ~ FromMaybe () o' => Outputs o' -> Maybe (Outputs ('Just (StringHashMap String o)))
  mappingO None       = Just (Dicts [XmlO, JsonO])
  mappingO (Dicts os) =
    case mapMaybe mappingDictO os of
      []  -> Nothing
      mos -> Just (Dicts mos)
    where
      mappingDictO :: Output o -> Maybe (Output (StringHashMap String o))
      mappingDictO XmlO  = Just XmlO
      mappingDictO JsonO = Just JsonO
      mappingDictO _     = Nothing
  
  statusO :: (e ~ FromMaybe Void e', o ~ FromMaybe () o')
          => Errors e' -> Outputs o' -> Maybe (Outputs ('Just (Status e o)))
  statusO None       None       = Just (Dicts [XmlO, JsonO])
  statusO None       (Dicts os) = mkStatusDict [XmlE, JsonE] os
  statusO (Dicts es) None       = mkStatusDict es           [XmlO, JsonO]
  statusO (Dicts es) (Dicts os) = mkStatusDict es           os
  
  mkStatusDict :: forall e o. [Error e] -> [Output o] -> Maybe (Outputs ('Just (Status e o)))
  mkStatusDict es os =
      case mapMaybe mappingDictO (es `intersect` os) of
        []  -> Nothing
        sos -> Just (Dicts sos)
      where
        mappingDictO :: (Error e, Output o) -> Maybe (Output (Status e o))
        mappingDictO (XmlE , XmlO ) = Just XmlO
        mappingDictO (JsonE, JsonO) = Just JsonO
        mappingDictO _              = Nothing
  
  intersect :: [Error e] -> [Output o] -> [(Error e, Output o)]
  intersect [] _  = []
  intersect _  [] = []
  intersect es os = [ (e, o) | e <- es, o <- os, e `eq` o ]
    where
      XmlE  `eq` XmlO  = True
      JsonE `eq` JsonO = True
      _     `eq` _     = False
  
  reasonE :: e ~ FromMaybe Void e' => Errors e' -> Errors ('Just (Reason e))
  reasonE None       = Dicts [XmlE, JsonE]
  reasonE (Dicts es) = Dicts (map reasonDictE es)
    where
      reasonDictE :: Error a -> Error (Reason a)
      reasonDictE XmlE  = XmlE
      reasonDictE JsonE = JsonE
  
  defaultE :: Errors ('Just Reason_)
  defaultE = Dicts [XmlE, JsonE]
  