module Data.Foscam.File.Alias(
Alias(..)
, AsAlias(..)
, AsAliasHead(..)
, AsAliasTail(..)
, alias
) where
import Control.Applicative(Applicative((<*>)), (<$>))
import Control.Category(Category(id))
import Control.Lens(Optic', Choice, Cons(_Cons), prism', lens, (^?), (#))
import Control.Monad(Monad)
import Data.Eq(Eq)
import Data.Foscam.File.AliasCharacter(AliasCharacter, AsAliasCharacter(_AliasCharacter), aliasCharacter)
import Data.Functor(Functor)
import Data.Maybe(Maybe(Nothing, Just))
import Data.Ord(Ord)
import Data.String(String)
import Data.Traversable(traverse)
import Prelude(Show)
import Text.Parser.Char(CharParsing)
import Text.Parser.Combinators(many, (<?>), try)
data Alias =
Alias
AliasCharacter
[AliasCharacter]
deriving (Eq, Ord, Show)
class AsAlias p f s where
_Alias ::
Optic' p f s Alias
instance AsAlias p f Alias where
_Alias =
id
instance (Choice p, Applicative f) => AsAlias p f String where
_Alias =
prism'
(\(Alias h t) -> (_AliasCharacter #) <$> (h:t))
(\s -> case s of
[] ->
Nothing
h:t ->
let ch = (^? _AliasCharacter)
in Alias <$> ch h <*> traverse ch t)
instance Cons Alias Alias AliasCharacter AliasCharacter where
_Cons =
prism'
(\(h, Alias h' t) -> Alias h (h':t))
(\(Alias h t) -> case t of
[] ->
Nothing
u:v ->
Just (h, Alias u v))
class AsAliasHead p f s where
_AliasHead ::
Optic' p f s AliasCharacter
instance AsAliasHead p f AliasCharacter where
_AliasHead =
id
instance (p ~ (->), Functor f) => AsAliasHead p f Alias where
_AliasHead =
lens
(\(Alias h _) -> h)
(\(Alias _ t) h -> Alias h t)
class AsAliasTail p f s where
_AliasTail ::
Optic' p f s [AliasCharacter]
instance AsAliasTail p f [AliasCharacter] where
_AliasTail =
id
instance (p ~ (->), Functor f) => AsAliasTail p f Alias where
_AliasTail =
lens
(\(Alias _ t) -> t)
(\(Alias h _) t -> Alias h t)
alias ::
(Monad f, CharParsing f) =>
f Alias
alias =
let a = try aliasCharacter
in Alias <$> a <*> many a <?> "alias"