AliasCharacter.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

module Data.Foscam.File.AliasCharacter (
  AliasCharacter
, AsAliasCharacter(..)
, aliasCharacter
) where

import Control.Applicative(Applicative(pure), (<$>))
import Control.Category(Category((.), id))
import Control.Lens(Optic', Choice, prism')
import Control.Monad(Monad(fail))
import Data.Char(Char)
import Data.Eq(Eq)
import Data.Foscam.File.Internal(boolj, charP)
import Data.List((++), notElem)
import Data.Ord(Ord)
import Prelude(Show)
import Text.Parser.Char(CharParsing)
import Text.Parser.Combinators((<?>))

-- $setup
-- >>> import Text.Parsec

newtype AliasCharacter = 
  AliasCharacter Char
  deriving (Eq, Ord, Show)

class AsAliasCharacter p f s where
  _AliasCharacter ::
    Optic' p f s AliasCharacter

instance AsAliasCharacter p f AliasCharacter where
  _AliasCharacter =
    id

instance (Choice p, Applicative f) => AsAliasCharacter p f Char where
  _AliasCharacter =
    prism'
      (\(AliasCharacter c) -> c)
      ((AliasCharacter <$>) . boolj (`notElem` ['/', ':', '*', '?', '"', '<', '>', '(', ')']))

-- todo: _1 to _12 ??   

-- |
--
-- >>> parse aliasCharacter "test" "2062"
-- Right (AliasCharacter '2')
-- 
-- >>> parse aliasCharacter "test" "2"
-- Right (AliasCharacter '2')
-- 
-- >>> parse aliasCharacter "test" "abc"
-- Right (AliasCharacter 'a')
-- 
-- >>> parse aliasCharacter "test" "*"
-- Left "test" (line 1, column 2):
-- not an alias character: *
-- 
-- >>> parse aliasCharacter "test" "<"
-- Left "test" (line 1, column 2):
-- not an alias character: <
-- 
-- >>> parse aliasCharacter "test" ""
-- Left "test" (line 1, column 1):
-- unexpected end of input
-- expecting alias character
aliasCharacter ::
  (Monad f, CharParsing f) =>
  f AliasCharacter
aliasCharacter =
  charP (fail . ("not an alias character: " ++) . pure) _AliasCharacter <?> "alias character"