    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE ViewPatterns #-}

    module Data.SCargot.Repr.WellFormed
           ( -- * 'WellFormedSExpr' representation
             R.WellFormedSExpr(..)
           , R.toWellFormed
           , R.fromWellFormed
             -- * Constructing and Deconstructing
           , cons
           , uncons
             -- * Useful pattern synonyms
           , pattern (:::)
           , pattern L
           , pattern A
           , pattern Nil
             -- * Useful processing functions
           , fromPair
           , fromList
           , fromAtom
           , asPair
           , asList
           , isAtom
           , isNil
           , asAtom
           , asAssoc
           , car
           , cdr
           ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>), (<*>), pure)
    #endif
    import Data.SCargot.Repr as R

    -- | Produce the head and tail of the s-expression (if possible).
    --
    -- >>> uncons (L [A "el", A "eph", A "ant"])
    -- Just (WFSAtom "el",WFSList [WFSAtom "eph",WFSAtom "ant"])
    uncons :: WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
    uncons :: forall a.
    WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
    uncons R.WFSAtom {}       = Maybe (WellFormedSExpr a, WellFormedSExpr a)
    forall a. Maybe a
    Nothing
    uncons (R.WFSList [])     = Maybe (WellFormedSExpr a, WellFormedSExpr a)
    forall a. Maybe a
    Nothing
    uncons (R.WFSList (WellFormedSExpr a
    x:[WellFormedSExpr a]
    xs)) = (WellFormedSExpr a, WellFormedSExpr a)
    -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
    forall a. a -> Maybe a
    Just (WellFormedSExpr a
    x, [WellFormedSExpr a] -> WellFormedSExpr a
    forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
    R.WFSList [WellFormedSExpr a]
    xs)

    -- | Combine the two-expressions into a new one. This will return
    --   @Nothing@ if the resulting s-expression is not well-formed.
    --
    -- >>> cons (A "el") (L [A "eph", A "ant"])
    -- Just (WFSList [WFSAtom "el",WFSAtom "eph",WFSAtom "ant"])
    -- >>> cons (A "pachy") (A "derm"))
    -- Nothing
    cons :: WellFormedSExpr a -> WellFormedSExpr a -> Maybe (WellFormedSExpr a)
    cons :: forall a.
    WellFormedSExpr a -> WellFormedSExpr a -> Maybe (WellFormedSExpr a)
    cons WellFormedSExpr a
    _ (R.WFSAtom {}) = Maybe (WellFormedSExpr a)
    forall a. Maybe a
    Nothing
    cons WellFormedSExpr a
    x (R.WFSList [WellFormedSExpr a]
    xs) = WellFormedSExpr a -> Maybe (WellFormedSExpr a)
    forall a. a -> Maybe a
    Just ([WellFormedSExpr a] -> WellFormedSExpr a
    forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
    R.WFSList (WellFormedSExpr a
    xWellFormedSExpr a -> [WellFormedSExpr a] -> [WellFormedSExpr a]
    forall a. a -> [a] -> [a]
    :[WellFormedSExpr a]
    xs))

    -- | A shorter infix alias to grab the head and tail of a `WFSList`. This
    --   pattern is unidirectional, because it cannot be guaranteed that it
    --   is used to construct well-formed s-expressions; use the function "cons"
    --   instead.
    --
    -- >>> let sum (x ::: xs) = x + sum xs; sum Nil = 0
    #if MIN_VERSION_base(4,8,0)
    pattern (:::) :: WellFormedSExpr a -> WellFormedSExpr a -> WellFormedSExpr a
    #endif
    pattern x $m::: :: forall {r} {a}.
    WellFormedSExpr a
    -> (WellFormedSExpr a -> WellFormedSExpr a -> r)
    -> ((# #) -> r)
    -> r
    ::: xs <- (uncons -> Just (x, xs))

    -- | A shorter alias for `WFSList`
    --
    -- >>> L [A "pachy", A "derm"]
    -- WFSList [WFSAtom "pachy",WFSAtom "derm"]
    #if MIN_VERSION_base(4,8,0)
    pattern L :: [WellFormedSExpr t] -> WellFormedSExpr t
    #endif
    pattern $mL :: forall {r} {t}.
    WellFormedSExpr t
    -> ([WellFormedSExpr t] -> r) -> ((# #) -> r) -> r
    $bL :: forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
    L xs = R.WFSList xs

    -- | A shorter alias for `WFSAtom`
    --
    -- >>> A "elephant"
    -- WFSAtom "elephant"
    #if MIN_VERSION_base(4,8,0)
    pattern A :: t -> WellFormedSExpr t
    #endif
    pattern $mA :: forall {r} {t}. WellFormedSExpr t -> (t -> r) -> ((# #) -> r) -> r
    $bA :: forall t. t -> WellFormedSExpr t
    A a  = R.WFSAtom a

    -- | A shorter alias for `WFSList` @[]@
    --
    -- >>> Nil
    -- WFSList []
    #if MIN_VERSION_base(4,8,0)
    pattern Nil :: WellFormedSExpr t
    #endif
    pattern $mNil :: forall {r} {t}.
    WellFormedSExpr t -> ((# #) -> r) -> ((# #) -> r) -> r
    $bNil :: forall t. WellFormedSExpr t
    Nil = R.WFSList []

    getShape :: WellFormedSExpr a -> String
    getShape :: forall a. WellFormedSExpr a -> String
    getShape WFSAtom {}   = String
    "atom"
    getShape (WFSList []) = String
    "empty list"
    getShape (WFSList [WellFormedSExpr a]
    sx) = String
    "list of length " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([WellFormedSExpr a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [WellFormedSExpr a]
    sx)

    -- | Utility function for parsing a pair of things.
    --
    -- >>> fromPair (isAtom "pachy") (asAtom return) (L [A "pachy", A "derm"])
    -- Right ((), "derm")
    -- >>> fromPair (isAtom "pachy") fromAtom (L [A "pachy"])
    -- Left "Expected two-element list"
    fromPair :: (WellFormedSExpr t -> Either String a)
             -> (WellFormedSExpr t -> Either String b)
             -> WellFormedSExpr t -> Either String (a, b)
    fromPair :: forall t a b.
    (WellFormedSExpr t -> Either String a)
    -> (WellFormedSExpr t -> Either String b)
    -> WellFormedSExpr t
    -> Either String (a, b)
    fromPair WellFormedSExpr t -> Either String a
    pl WellFormedSExpr t -> Either String b
    pr (L [WellFormedSExpr t
    l, WellFormedSExpr t
    r]) = (,) (a -> b -> (a, b))
    -> Either String a -> Either String (b -> (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WellFormedSExpr t -> Either String a
    pl WellFormedSExpr t
    l Either String (b -> (a, b))
    -> Either String b -> Either String (a, b)
    forall a b.
    Either String (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> WellFormedSExpr t -> Either String b
    pr WellFormedSExpr t
    r
    fromPair WellFormedSExpr t -> Either String a
    _  WellFormedSExpr t -> Either String b
    _  WellFormedSExpr t
    sx = String -> Either String (a, b)
    forall a b. a -> Either a b
    Left (String
    "fromPair: expected two-element list; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Utility function for parsing a list of things.
    --
    -- >>> fromList fromAtom (L [A "this", A "that", A "the-other"])
    -- Right ["this","that","the-other"]
    -- >>> fromList fromAtom (A "pachyderm")
    -- Left "asList: expected proper list; found dotted list"
    fromList :: (WellFormedSExpr t -> Either String a)
             -> WellFormedSExpr t -> Either String [a]
    fromList :: forall t a.
    (WellFormedSExpr t -> Either String a)
    -> WellFormedSExpr t -> Either String [a]
    fromList WellFormedSExpr t -> Either String a
    p (L [WellFormedSExpr t]
    ss) = (WellFormedSExpr t -> Either String a)
    -> [WellFormedSExpr t] -> Either String [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM WellFormedSExpr t -> Either String a
    p [WellFormedSExpr t]
    ss
    fromList WellFormedSExpr t -> Either String a
    _ WellFormedSExpr t
    sx     = String -> Either String [a]
    forall a b. a -> Either a b
    Left (String
    "fromList: expected list; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Utility function for parsing a single atom
    --
    -- >>> fromAtom (A "elephant")
    -- Right "elephant"
    -- >>> fromAtom (L [A "elephant"])
    -- Left "fromAtom: expected atom; found list"
    fromAtom :: WellFormedSExpr t -> Either String t
    fromAtom :: forall t. WellFormedSExpr t -> Either String t
    fromAtom (A t
    a) = t -> Either String t
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return t
    a
    fromAtom WellFormedSExpr t
    sx    = String -> Either String t
    forall a b. a -> Either a b
    Left (String
    "fromAtom: expected atom; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Parses a two-element list using the provided function.
    --
    -- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
    -- >>> asPair go (L [A "pachy", A "derm"])
    -- Right "pachyderm"
    -- >>> asPair go (L [A "elephant"])
    -- Left "asPair: expected two-element list; found list of length 1"
    asPair :: ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
           -> WellFormedSExpr t -> Either String a
    asPair :: forall t a.
    ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
    -> WellFormedSExpr t -> Either String a
    asPair (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
    f (L [WellFormedSExpr t
    l, WellFormedSExpr t
    r]) = (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
    f (WellFormedSExpr t
    l, WellFormedSExpr t
    r)
    asPair (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
    _ WellFormedSExpr t
    sx         = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "asPair: expected two-element list; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Parse an arbitrary-length list using the provided function.
    --
    -- >>> let go xs = concat <$> mapM fromAtom xs
    -- >>> asList go (L [A "el", A "eph", A "ant"])
    -- Right "elephant"
    -- >>> asList go (A "pachyderm")
    -- Left "asList: expected list; found atom"
    asList :: ([WellFormedSExpr t] -> Either String a)
           -> WellFormedSExpr t -> Either String a
    asList :: forall t a.
    ([WellFormedSExpr t] -> Either String a)
    -> WellFormedSExpr t -> Either String a
    asList [WellFormedSExpr t] -> Either String a
    f (L [WellFormedSExpr t]
    ls) = [WellFormedSExpr t] -> Either String a
    f [WellFormedSExpr t]
    ls
    asList [WellFormedSExpr t] -> Either String a
    _ WellFormedSExpr t
    sx     = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "asList: expected list; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Match a given literal atom, failing otherwise.
    --
    -- >>> isAtom "elephant" (A "elephant")
    -- Right ()
    -- >>> isAtom "elephant" (L [A "elephant"])
    -- Left "isAtom: expected atom; found list"
    isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
    isAtom :: forall t. Eq t => t -> WellFormedSExpr t -> Either String ()
    isAtom t
    s (A t
    s')
      | t
    s t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    s'   = () -> Either String ()
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise = String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "isAtom: failed to match atom"
    isAtom t
    _ WellFormedSExpr t
    sx  = String -> Either String ()
    forall a b. a -> Either a b
    Left (String
    "isAtom: expected atom; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Match an empty list, failing otherwise.
    --
    -- >>> isNil (L [])
    -- Right ()
    -- >>> isNil (A "elephant")
    -- Left "isNil: expected nil; found atom"
    isNil :: WellFormedSExpr t -> Either String ()
    isNil :: forall t. WellFormedSExpr t -> Either String ()
    isNil WellFormedSExpr t
    Nil = () -> Either String ()
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    isNil WellFormedSExpr t
    sx  = String -> Either String ()
    forall a b. a -> Either a b
    Left (String
    "isNil: expected nil; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Parse an atom using the provided function.
    --
    -- >>> import Data.Char (toUpper)
    -- >>> asAtom (return . map toUpper) (A "elephant")
    -- Right "ELEPHANT"
    -- >>> asAtom (return . map toUpper) (L [])
    -- Left "asAtom: expected atom; found list"
    asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
    asAtom :: forall t a.
    (t -> Either String a) -> WellFormedSExpr t -> Either String a
    asAtom t -> Either String a
    f (A t
    s) = t -> Either String a
    f t
    s
    asAtom t -> Either String a
    _ WellFormedSExpr t
    sx    = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "asAtom: expected atom; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Parse an assoc-list using the provided function.
    --
    -- >>> let def (x, y) = do { a <- fromAtom x; b <- fromAtom y; return (a ++ ": " ++ b) }
    -- >>> let defList xs = do { defs <- mapM def xs; return (unlines defs) }
    -- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "trunk", A "one"] ])
    -- Right "legs: four\ntrunk: one\n"
    -- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "elephant"] ])
    -- Left "asAssoc: expected pair; found list of length 1"
    asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
            -> WellFormedSExpr t -> Either String a
    asAssoc :: forall t a.
    ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
    -> WellFormedSExpr t -> Either String a
    asAssoc [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
    f (L [WellFormedSExpr t]
    ss) = [WellFormedSExpr t]
    -> Either String [(WellFormedSExpr t, WellFormedSExpr t)]
    forall {a}.
    [WellFormedSExpr a]
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    gatherPairs [WellFormedSExpr t]
    ss Either String [(WellFormedSExpr t, WellFormedSExpr t)]
    -> ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
    -> Either String a
    forall a b.
    Either String a -> (a -> Either String b) -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
    f
      where gatherPairs :: [WellFormedSExpr a]
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    gatherPairs (L [WellFormedSExpr a
    a, WellFormedSExpr a
    b] : [WellFormedSExpr a]
    ts) = (:) ((WellFormedSExpr a, WellFormedSExpr a)
     -> [(WellFormedSExpr a, WellFormedSExpr a)]
     -> [(WellFormedSExpr a, WellFormedSExpr a)])
    -> Either String (WellFormedSExpr a, WellFormedSExpr a)
    -> Either
         String
         ([(WellFormedSExpr a, WellFormedSExpr a)]
          -> [(WellFormedSExpr a, WellFormedSExpr a)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WellFormedSExpr a, WellFormedSExpr a)
    -> Either String (WellFormedSExpr a, WellFormedSExpr a)
    forall a. a -> Either String a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WellFormedSExpr a
    a, WellFormedSExpr a
    b) Either
      String
      ([(WellFormedSExpr a, WellFormedSExpr a)]
       -> [(WellFormedSExpr a, WellFormedSExpr a)])
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    forall a b.
    Either String (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [WellFormedSExpr a]
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    gatherPairs [WellFormedSExpr a]
    ts
            gatherPairs []              = [(WellFormedSExpr a, WellFormedSExpr a)]
    -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    forall a. a -> Either String a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
            gatherPairs (WellFormedSExpr a
    sx:[WellFormedSExpr a]
    _)          = String -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
    forall a b. a -> Either a b
    Left (String
    "asAssoc: expected pair; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr a -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr a
    sx)
    asAssoc [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
    _ WellFormedSExpr t
    sx     = String -> Either String a
    forall a b. a -> Either a b
    Left (String
    "asAssoc: expected list; found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ WellFormedSExpr t -> String
    forall a. WellFormedSExpr a -> String
    getShape WellFormedSExpr t
    sx)

    -- | Run the parser on the first element of a Haskell list of "WellFormedSExpr" values,
    --   failing if the list is empty. This is useful in conjunction with the `asList`
    --   function.
    car :: (WellFormedSExpr t -> Either String t')
        -> [WellFormedSExpr t] -> Either String t'
    car :: forall t t'.
    (WellFormedSExpr t -> Either String t')
    -> [WellFormedSExpr t] -> Either String t'
    car WellFormedSExpr t -> Either String t'
    f (WellFormedSExpr t
    x:[WellFormedSExpr t]
    _) = WellFormedSExpr t -> Either String t'
    f WellFormedSExpr t
    x
    car WellFormedSExpr t -> Either String t'
    _ []    = String -> Either String t'
    forall a b. a -> Either a b
    Left String
    "car: Taking car of zero-element list"

    -- | Run the parser on all but the first element of a Haskell list of "WellFormedSExpr" values,
    --   failing if the list is empty. This is useful in conjunction with the `asList`
    --   function.
    cdr :: ([WellFormedSExpr t] -> Either String t')
        -> [WellFormedSExpr t] -> Either String t'
    cdr :: forall t t'.
    ([WellFormedSExpr t] -> Either String t')
    -> [WellFormedSExpr t] -> Either String t'
    cdr [WellFormedSExpr t] -> Either String t'
    f (WellFormedSExpr t
    _:[WellFormedSExpr t]
    xs) = [WellFormedSExpr t] -> Either String t'
    f [WellFormedSExpr t]
    xs
    cdr [WellFormedSExpr t] -> Either String t'
    _ []     = String -> Either String t'
    forall a b. a -> Either a b
    Left String
    "cdr: Taking cdr of zero-element list"