{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE CPP #-}

module Control.Monad.Apiary.Filter.Internal.Strategy where

import Data.Apiary.SList
import qualified Data.Text as T
import Data.Apiary.Document

import Data.Typeable
import Data.Maybe
import Data.Reflection
#if __GLASGOW_HASKELL__ < 707
import Data.Proxy
#endif

class Strategy (w :: * -> *) where
    type SNext w (as :: [*]) a  :: [*]
    readStrategy :: (v -> Maybe a)
                 -> ((k,v) -> Bool)
                 -> proxy (w a)
                 -> [(k, v)]
                 -> SList as 
                 -> Maybe (SList (SNext w as a))
    strategyRep :: proxy w -> StrategyRep

getQuery :: (v -> Maybe a) -> proxy (w a) -> ((k,v) -> Bool) -> [(k, v)] -> [Maybe a]
getQuery readf _ kf = map readf . map snd . filter kf

-- | get first matched key( [1,) params to Type.). since 0.5.0.0.
data Option a deriving Typeable
instance Strategy Option where
    type SNext Option as a = Snoc as (Maybe a)
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else Just . sSnoc l $ case catMaybes rs of
               []  -> Nothing
               a:_ -> Just a
    strategyRep _ = StrategyRep "optional"

-- | get first matched key ( [0,) params to Maybe Type.) since 0.5.0.0.
data First a deriving Typeable
instance Strategy First where
    type SNext First as a = Snoc as a
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else case catMaybes rs of
               [] -> Nothing
               a:_ -> Just $ sSnoc l a
    strategyRep _ = StrategyRep "first"

-- | get key ( [1] param to Type.) since 0.5.0.0.
data One a deriving Typeable
instance Strategy One where
    type SNext One as a = Snoc as a
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else case catMaybes rs of
               [a] -> Just $ sSnoc l a
               _   -> Nothing
    strategyRep _ = StrategyRep "one"

-- | get parameters ( [0,) params to [Type] ) since 0.5.0.0.
data Many a deriving Typeable
instance Strategy Many where
    type SNext Many as a = Snoc as [a]
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else Just $ sSnoc l (catMaybes rs)
    strategyRep _ = StrategyRep "many"

-- | get parameters ( [1,) params to [Type] ) since 0.5.0.0.
data Some a deriving Typeable
instance Strategy Some where
    type SNext Some as a = Snoc as [a]
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else case catMaybes rs of
               [] -> Nothing
               as -> Just $ sSnoc l as
    strategyRep _ = StrategyRep "some"

-- | get parameters with upper limit ( [1,n] to [Type]) since 0.6.0.0.
data LimitSome u a deriving Typeable
instance (Reifies u Int) => Strategy (LimitSome u) where
    type SNext (LimitSome u) as a = Snoc as [a]
    readStrategy rf k p q l =
        let rs = take (reflectLimit p) $ getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else case catMaybes rs of
               [] -> Nothing
               as -> Just $ sSnoc l as
    strategyRep _ = StrategyRep . T.pack $ "less then " ++ show (reflect (Proxy :: Proxy u))

reflectLimit :: Reifies n Int => proxy (LimitSome n a) -> Int
reflectLimit p = reflect $ asTyInt p
  where
    asTyInt :: proxy (LimitSome u a) -> Proxy u
    asTyInt _ = Proxy

-- | type check ( [0,) params to No argument ) since 0.5.0.0.
data Check a deriving Typeable
instance Strategy Check where
    type SNext Check as a = as
    readStrategy rf k p q l =
        let rs = getQuery rf p k q
        in if any isNothing rs
           then Nothing
           else case  catMaybes rs of
               [] -> Nothing
               _  -> Just l
    strategyRep _ = StrategyRep "check"

-- | construct Option proxy. since 0.5.1.0.
pOption :: proxy a -> Proxy (Option a)
pOption _ = Proxy

-- | construct First proxy. since 0.5.1.0.
pFirst :: proxy a -> Proxy (First a)
pFirst _ = Proxy

-- | construct One proxy. since 0.5.1.0.
pOne :: proxy a -> Proxy (One a)
pOne _ = Proxy

-- | construct Many proxy. since 0.5.1.0.
pMany :: proxy a -> Proxy (Many a)
pMany _ = Proxy

-- | construct Some proxy. since 0.5.1.0.
pSome :: proxy a -> Proxy (Some a)
pSome _ = Proxy

-- | construct Check proxy. since 0.5.1.0.
pCheck :: proxy a -> Proxy (Check a)
pCheck _ = Proxy