{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module : Data.Herb.Instances
-- Description : Several common instances for Herb
--
-- This module only provides several instances of typeclasses for producing and
-- parsing `Herb`. Its main use is for starting up without too much coding; for
-- more complicated projects you might want to avoid importing this and instead
-- write some (possibly much more conservative) instances yourself.
module Data.Herb.Instances where

import Data.Herb

import Control.Applicative
import Data.Functor.Compose
import Data.Functor.Identity
import qualified Data.Text as T

instance ToHerb1 Identity where
  liftToHerb :: forall a. (a -> Herb) -> Identity a -> Herb
liftToHerb a -> Herb
r = a -> Herb
r (a -> Herb) -> (Identity a -> a) -> Identity a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity

instance (ToHerb1 f, ToHerb1 g) => ToHerb1 (Compose f g) where
  liftToHerb :: forall a. (a -> Herb) -> Compose f g a -> Herb
liftToHerb a -> Herb
r = (g a -> Herb) -> f (g a) -> Herb
forall a. (a -> Herb) -> f a -> Herb
forall (f :: * -> *) a. ToHerb1 f => (a -> Herb) -> f a -> Herb
liftToHerb ((a -> Herb) -> g a -> Herb
forall a. (a -> Herb) -> g a -> Herb
forall (f :: * -> *) a. ToHerb1 f => (a -> Herb) -> f a -> Herb
liftToHerb a -> Herb
r) (f (g a) -> Herb)
-> (Compose f g a -> f (g a)) -> Compose f g a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance FromHerb1 Identity where
  liftParseHerb :: forall a. Parser Herb a -> Parser Herb (Identity a)
liftParseHerb Parser Herb a
r = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Parser Herb a -> Parser Herb (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb a
r

instance (FromHerb1 f, FromHerb1 g) => FromHerb1 (Compose f g) where
  liftParseHerb :: forall a. Parser Herb a -> Parser Herb (Compose f g a)
liftParseHerb = (f (g a) -> Compose f g a)
-> Parser Herb (f (g a)) -> Parser Herb (Compose f g a)
forall a b. (a -> b) -> Parser Herb a -> Parser Herb b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser Herb (f (g a)) -> Parser Herb (Compose f g a))
-> (Parser Herb a -> Parser Herb (f (g a)))
-> Parser Herb a
-> Parser Herb (Compose f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Herb (g a) -> Parser Herb (f (g a))
forall a. Parser Herb a -> Parser Herb (f a)
forall (f :: * -> *) a.
FromHerb1 f =>
Parser Herb a -> Parser Herb (f a)
liftParseHerb (Parser Herb (g a) -> Parser Herb (f (g a)))
-> (Parser Herb a -> Parser Herb (g a))
-> Parser Herb a
-> Parser Herb (f (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Herb a -> Parser Herb (g a)
forall a. Parser Herb a -> Parser Herb (g a)
forall (f :: * -> *) a.
FromHerb1 f =>
Parser Herb a -> Parser Herb (f a)
liftParseHerb

instance ToHerb () where
  toHerb :: () -> Herb
toHerb () = Ident -> Herb
Atom Ident
"()"

instance FromHerb () where
  parseHerb :: Parser Herb ()
parseHerb = () () -> Parser Herb Ident -> Parser Herb ()
forall a b. a -> Parser Herb b -> Parser Herb a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ident -> Parser Herb Ident
exactAtom Ident
"()"

instance ToHerb Ident where
  toHerb :: Ident -> Herb
toHerb = Ident -> Herb
Atom

instance FromHerb Ident where
  parseHerb :: Parser Herb Ident
parseHerb = (Ident -> Bool) -> Parser Herb Ident
satisfyAtom (Bool -> Ident -> Bool
forall a b. a -> b -> a
const Bool
True)

instance ToHerb a => ToHerb (Maybe a) where
  toHerb :: Maybe a -> Herb
toHerb Maybe a
Nothing = Ident -> Herb
Atom Ident
"Nothing"
  toHerb (Just a
a) = Ident -> [Herb] -> Herb
Struct Ident
"Just" [a -> Herb
forall a. ToHerb a => a -> Herb
toHerb a
a]

instance FromHerb a => FromHerb (Maybe a) where
  parseHerb :: Parser Herb (Maybe a)
parseHerb =
    Maybe a
forall a. Maybe a
Nothing Maybe a -> Parser Herb Ident -> Parser Herb (Maybe a)
forall a b. a -> Parser Herb b -> Parser Herb a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ident -> Parser Herb Ident
exactAtom Ident
"Nothing" Parser Herb (Maybe a)
-> Parser Herb (Maybe a) -> Parser Herb (Maybe a)
forall a. Parser Herb a -> Parser Herb a -> Parser Herb a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Ident -> Parser [Herb] (Maybe a) -> Parser Herb (Maybe a)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
"Just" (Parser [Herb] (Maybe a) -> Parser Herb (Maybe a))
-> Parser [Herb] (Maybe a) -> Parser Herb (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> Parser [Herb] (Maybe a)
forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
singleArg a -> Maybe a
forall a. a -> Maybe a
Just)

instance ToHerb Int where
  toHerb :: Int -> Herb
toHerb = Int -> Herb
forall a. Show a => a -> Herb
atomShow

instance FromHerb Int where
  parseHerb :: Parser Herb Int
parseHerb = Parser Herb Int
forall a. Read a => Parser Herb a
atomRead

instance ToHerb Integer where
  toHerb :: Integer -> Herb
toHerb = Integer -> Herb
forall a. Show a => a -> Herb
atomShow

instance FromHerb Integer where
  parseHerb :: Parser Herb Integer
parseHerb = Parser Herb Integer
forall a. Read a => Parser Herb a
atomRead

instance ToHerb Char where
  toHerb :: Char -> Herb
toHerb = Ident -> Herb
Atom (Ident -> Herb) -> (Char -> Ident) -> Char -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Ident
T.singleton

instance FromHerb Char where
  parseHerb :: Parser Herb Char
parseHerb = do
    Atom x <- Parser Herb Herb
forall h. Parser h h
get
    case unpackIdent x of
      [Char
c] -> Char -> Parser Herb Char
forall a. a -> Parser Herb a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      String
_ -> String -> Parser Herb Char
forall a. String -> Parser Herb a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"char"

instance ToHerb a => ToHerb [a] where
  toHerb :: [a] -> Herb
toHerb = Ident -> [Herb] -> Herb
Struct Ident
"[]" ([Herb] -> Herb) -> ([a] -> [Herb]) -> [a] -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Herb) -> [a] -> [Herb]
forall a b. (a -> b) -> [a] -> [b]
map a -> Herb
forall a. ToHerb a => a -> Herb
toHerb

instance FromHerb a => FromHerb [a] where
  parseHerb :: Parser Herb [a]
parseHerb =
    Ident -> Parser [Herb] [a] -> Parser Herb [a]
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
"[]" (Parser [Herb] [a] -> Parser Herb [a])
-> Parser [Herb] [a] -> Parser Herb [a]
forall a b. (a -> b) -> a -> b
$ do
      Parser [Herb] [Herb]
forall h. Parser h h
get Parser [Herb] [Herb]
-> ([Herb] -> Parser [Herb] [a]) -> Parser [Herb] [a]
forall a b.
Parser [Herb] a -> (a -> Parser [Herb] b) -> Parser [Herb] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Herb -> Parser [Herb] a) -> [Herb] -> Parser [Herb] [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Herb -> Parser Herb a -> Parser [Herb] a)
-> Parser Herb a -> Herb -> Parser [Herb] a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Herb -> Parser Herb a -> Parser [Herb] a
forall l a h. l -> Parser l a -> Parser h a
local Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb)

instance (ToHerb l, ToHerb r) => ToHerb (Either l r) where
  toHerb :: Either l r -> Herb
toHerb (Left l
l) = Ident -> [Herb] -> Herb
Struct Ident
"Left" [l -> Herb
forall a. ToHerb a => a -> Herb
toHerb l
l]
  toHerb (Right r
r) = Ident -> [Herb] -> Herb
Struct Ident
"Right" [r -> Herb
forall a. ToHerb a => a -> Herb
toHerb r
r]

instance (FromHerb l, FromHerb r) => FromHerb (Either l r) where
  parseHerb :: Parser Herb (Either l r)
parseHerb =
    Ident -> Parser [Herb] (Either l r) -> Parser Herb (Either l r)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
"Left" ((l -> Either l r) -> Parser [Herb] (Either l r)
forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
singleArg l -> Either l r
forall a b. a -> Either a b
Left)
      Parser Herb (Either l r)
-> Parser Herb (Either l r) -> Parser Herb (Either l r)
forall a. Parser Herb a -> Parser Herb a -> Parser Herb a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Ident -> Parser [Herb] (Either l r) -> Parser Herb (Either l r)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
"Right" ((r -> Either l r) -> Parser [Herb] (Either l r)
forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
singleArg r -> Either l r
forall a b. b -> Either a b
Right)

instance (ToHerb a, ToHerb b) => ToHerb (a, b) where
  toHerb :: (a, b) -> Herb
toHerb (a
a, b
b) = Ident -> [Herb] -> Herb
Struct Ident
"," [a -> Herb
forall a. ToHerb a => a -> Herb
toHerb a
a, b -> Herb
forall a. ToHerb a => a -> Herb
toHerb b
b]

instance (FromHerb a, FromHerb b) => FromHerb (a, b) where
  parseHerb :: Parser Herb (a, b)
parseHerb = Ident -> Parser [Herb] (a, b) -> Parser Herb (a, b)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
"," (Parser [Herb] (a, b) -> Parser Herb (a, b))
-> Parser [Herb] (a, b) -> Parser Herb (a, b)
forall a b. (a -> b) -> a -> b
$ (,) (a -> b -> (a, b))
-> Parser [Herb] a -> Parser [Herb] (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Herb] a
forall a. FromHerb a => Parser [Herb] a
popArg' Parser [Herb] (b -> (a, b))
-> Parser [Herb] b -> Parser [Herb] (a, b)
forall a b.
Parser [Herb] (a -> b) -> Parser [Herb] a -> Parser [Herb] b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Herb] b
forall a. FromHerb a => Parser [Herb] a
popArg' Parser [Herb] (a, b) -> Parser [Herb] () -> Parser [Herb] (a, b)
forall a b. Parser [Herb] a -> Parser [Herb] b -> Parser [Herb] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Herb] ()
forall h. Parser [h] ()
endOfArgs

instance (ToHerb a, ToHerb b, ToHerb c) => ToHerb (a, b, c) where
  toHerb :: (a, b, c) -> Herb
toHerb (a
a, b
b, c
c) = Ident -> [Herb] -> Herb
Struct Ident
",," [a -> Herb
forall a. ToHerb a => a -> Herb
toHerb a
a, b -> Herb
forall a. ToHerb a => a -> Herb
toHerb b
b, c -> Herb
forall a. ToHerb a => a -> Herb
toHerb c
c]

instance (FromHerb a, FromHerb b, FromHerb c) => FromHerb (a, b, c) where
  parseHerb :: Parser Herb (a, b, c)
parseHerb =
    Ident -> Parser [Herb] (a, b, c) -> Parser Herb (a, b, c)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
",," (Parser [Herb] (a, b, c) -> Parser Herb (a, b, c))
-> Parser [Herb] (a, b, c) -> Parser Herb (a, b, c)
forall a b. (a -> b) -> a -> b
$ (,,) (a -> b -> c -> (a, b, c))
-> Parser [Herb] a -> Parser [Herb] (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Herb] a
forall a. FromHerb a => Parser [Herb] a
popArg' Parser [Herb] (b -> c -> (a, b, c))
-> Parser [Herb] b -> Parser [Herb] (c -> (a, b, c))
forall a b.
Parser [Herb] (a -> b) -> Parser [Herb] a -> Parser [Herb] b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Herb] b
forall a. FromHerb a => Parser [Herb] a
popArg' Parser [Herb] (c -> (a, b, c))
-> Parser [Herb] c -> Parser [Herb] (a, b, c)
forall a b.
Parser [Herb] (a -> b) -> Parser [Herb] a -> Parser [Herb] b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Herb] c
forall a. FromHerb a => Parser [Herb] a
popArg' Parser [Herb] (a, b, c)
-> Parser [Herb] () -> Parser [Herb] (a, b, c)
forall a b. Parser [Herb] a -> Parser [Herb] b -> Parser [Herb] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Herb] ()
forall h. Parser [h] ()
endOfArgs

instance ToHerb Herb where
  toHerb :: Herb -> Herb
toHerb = Herb -> Herb
forall a. a -> a
id

instance FromHerb Herb where
  parseHerb :: Parser Herb Herb
parseHerb = Parser Herb Herb
forall h. Parser h h
get