{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
module Text.Hamlet.Parse
    ( Result (..)
    , Content (..)
    , Doc (..)
    , parseDoc
    , HamletSettings (..)
    , defaultHamletSettings
    , xhtmlHamletSettings
    , CloseStyle (..)
    , Binding (..)
    , NewlineStyle (..)
    , specialOrIdent
    , DataConstr (..)
    , Module (..)
    )
    where

import Text.Shakespeare.Base
import Control.Applicative ((<$>), Applicative (..))
import Control.Monad
import Control.Arrow
import Data.Char (GeneralCategory(..), generalCategory, isUpper)
import Data.Data
import Text.ParserCombinators.Parsec hiding (Line)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Maybe (mapMaybe, fromMaybe, isNothing)
import Language.Haskell.TH.Syntax hiding (Module)

data Result v = Error String | Ok v
    deriving (Int -> Result v -> ShowS
[Result v] -> ShowS
Result v -> String
(Int -> Result v -> ShowS)
-> (Result v -> String) -> ([Result v] -> ShowS) -> Show (Result v)
forall v. Show v => Int -> Result v -> ShowS
forall v. Show v => [Result v] -> ShowS
forall v. Show v => Result v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Result v -> ShowS
showsPrec :: Int -> Result v -> ShowS
$cshow :: forall v. Show v => Result v -> String
show :: Result v -> String
$cshowList :: forall v. Show v => [Result v] -> ShowS
showList :: [Result v] -> ShowS
Show, Result v -> Result v -> Bool
(Result v -> Result v -> Bool)
-> (Result v -> Result v -> Bool) -> Eq (Result v)
forall v. Eq v => Result v -> Result v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Result v -> Result v -> Bool
== :: Result v -> Result v -> Bool
$c/= :: forall v. Eq v => Result v -> Result v -> Bool
/= :: Result v -> Result v -> Bool
Eq, ReadPrec [Result v]
ReadPrec (Result v)
Int -> ReadS (Result v)
ReadS [Result v]
(Int -> ReadS (Result v))
-> ReadS [Result v]
-> ReadPrec (Result v)
-> ReadPrec [Result v]
-> Read (Result v)
forall v. Read v => ReadPrec [Result v]
forall v. Read v => ReadPrec (Result v)
forall v. Read v => Int -> ReadS (Result v)
forall v. Read v => ReadS [Result v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall v. Read v => Int -> ReadS (Result v)
readsPrec :: Int -> ReadS (Result v)
$creadList :: forall v. Read v => ReadS [Result v]
readList :: ReadS [Result v]
$creadPrec :: forall v. Read v => ReadPrec (Result v)
readPrec :: ReadPrec (Result v)
$creadListPrec :: forall v. Read v => ReadPrec [Result v]
readListPrec :: ReadPrec [Result v]
Read, Typeable (Result v)
Typeable (Result v) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Result v -> c (Result v))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Result v))
-> (Result v -> Constr)
-> (Result v -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Result v)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Result v)))
-> ((forall b. Data b => b -> b) -> Result v -> Result v)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Result v -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Result v -> r)
-> (forall u. (forall d. Data d => d -> u) -> Result v -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Result v -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Result v -> m (Result v))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result v -> m (Result v))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result v -> m (Result v))
-> Data (Result v)
Result v -> Constr
Result v -> DataType
(forall b. Data b => b -> b) -> Result v -> Result v
forall v. Data v => Typeable (Result v)
forall v. Data v => Result v -> Constr
forall v. Data v => Result v -> DataType
forall v.
Data v =>
(forall b. Data b => b -> b) -> Result v -> Result v
forall v u.
Data v =>
Int -> (forall d. Data d => d -> u) -> Result v -> u
forall v u.
Data v =>
(forall d. Data d => d -> u) -> Result v -> [u]
forall v r r'.
Data v =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
forall v r r'.
Data v =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
forall v (m :: * -> *).
(Data v, Monad m) =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
forall v (c :: * -> *).
Data v =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Result v)
forall v (c :: * -> *).
Data v =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result v -> c (Result v)
forall v (t :: * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Result v))
forall v (t :: * -> * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Result v))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Result v -> u
forall u. (forall d. Data d => d -> u) -> Result v -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Result v)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result v -> c (Result v)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Result v))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Result v))
$cgfoldl :: forall v (c :: * -> *).
Data v =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result v -> c (Result v)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result v -> c (Result v)
$cgunfold :: forall v (c :: * -> *).
Data v =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Result v)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Result v)
$ctoConstr :: forall v. Data v => Result v -> Constr
toConstr :: Result v -> Constr
$cdataTypeOf :: forall v. Data v => Result v -> DataType
dataTypeOf :: Result v -> DataType
$cdataCast1 :: forall v (t :: * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Result v))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Result v))
$cdataCast2 :: forall v (t :: * -> * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Result v))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Result v))
$cgmapT :: forall v.
Data v =>
(forall b. Data b => b -> b) -> Result v -> Result v
gmapT :: (forall b. Data b => b -> b) -> Result v -> Result v
$cgmapQl :: forall v r r'.
Data v =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
$cgmapQr :: forall v r r'.
Data v =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Result v -> r
$cgmapQ :: forall v u.
Data v =>
(forall d. Data d => d -> u) -> Result v -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Result v -> [u]
$cgmapQi :: forall v u.
Data v =>
Int -> (forall d. Data d => d -> u) -> Result v -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Result v -> u
$cgmapM :: forall v (m :: * -> *).
(Data v, Monad m) =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
$cgmapMp :: forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
$cgmapMo :: forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result v -> m (Result v)
Data, Typeable)
instance Monad Result where
    return :: forall a. a -> Result a
return = a -> Result a
forall a. a -> Result a
Ok
    Error String
s >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
_ = String -> Result b
forall v. String -> Result v
Error String
s
    Ok a
v >>= a -> Result b
f = a -> Result b
f a
v
#if MIN_VERSION_base(4,13,0)
instance MonadFail Result where
    fail :: forall v. String -> Result v
fail = String -> Result a
forall v. String -> Result v
Error
#endif
instance Functor Result where
    fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap = (a -> b) -> Result a -> Result b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Result where
    pure :: forall a. a -> Result a
pure = a -> Result a
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b. Result (a -> b) -> Result a -> Result b
(<*>) = Result (a -> b) -> Result a -> Result b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

data Content = ContentRaw String
             | ContentVar Deref
             | ContentUrl Bool Deref -- ^ bool: does it include params?
             | ContentEmbed Deref
             | ContentMsg Deref
             | ContentAttrs Deref
    deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> String
show :: Content -> String
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq, ReadPrec [Content]
ReadPrec Content
Int -> ReadS Content
ReadS [Content]
(Int -> ReadS Content)
-> ReadS [Content]
-> ReadPrec Content
-> ReadPrec [Content]
-> Read Content
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Content
readsPrec :: Int -> ReadS Content
$creadList :: ReadS [Content]
readList :: ReadS [Content]
$creadPrec :: ReadPrec Content
readPrec :: ReadPrec Content
$creadListPrec :: ReadPrec [Content]
readListPrec :: ReadPrec [Content]
Read, Typeable Content
Typeable Content =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Content -> c Content)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Content)
-> (Content -> Constr)
-> (Content -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Content))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content))
-> ((forall b. Data b => b -> b) -> Content -> Content)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Content -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Content -> r)
-> (forall u. (forall d. Data d => d -> u) -> Content -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Content -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> Data Content
Content -> Constr
Content -> DataType
(forall b. Data b => b -> b) -> Content -> Content
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
forall u. (forall d. Data d => d -> u) -> Content -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
$ctoConstr :: Content -> Constr
toConstr :: Content -> Constr
$cdataTypeOf :: Content -> DataType
dataTypeOf :: Content -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
$cgmapT :: (forall b. Data b => b -> b) -> Content -> Content
gmapT :: (forall b. Data b => b -> b) -> Content -> Content
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
Data, Typeable)

data Line = LineForall Deref Binding
          | LineIf Deref
          | LineElseIf Deref
          | LineElse
          | LineWith [(Deref, Binding)]
          | LineMaybe Deref Binding
          | LineNothing
          | LineCase Deref
          | LineOf Binding
          | LineTag
            { Line -> String
_lineTagName :: String
            , Line -> [(Maybe Deref, String, Maybe [Content])]
_lineAttr :: [(Maybe Deref, String, Maybe [Content])]
            , Line -> [Content]
_lineContent :: [Content]
            , Line -> [(Maybe Deref, [Content])]
_lineClasses :: [(Maybe Deref, [Content])]
            , Line -> [Deref]
_lineAttrs :: [Deref]
            , Line -> Bool
_lineNoNewline :: Bool
            }
          | LineContent [Content] Bool -- ^ True == avoid newlines
    deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
/= :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Line -> ShowS
showsPrec :: Int -> Line -> ShowS
$cshow :: Line -> String
show :: Line -> String
$cshowList :: [Line] -> ShowS
showList :: [Line] -> ShowS
Show, ReadPrec [Line]
ReadPrec Line
Int -> ReadS Line
ReadS [Line]
(Int -> ReadS Line)
-> ReadS [Line] -> ReadPrec Line -> ReadPrec [Line] -> Read Line
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Line
readsPrec :: Int -> ReadS Line
$creadList :: ReadS [Line]
readList :: ReadS [Line]
$creadPrec :: ReadPrec Line
readPrec :: ReadPrec Line
$creadListPrec :: ReadPrec [Line]
readListPrec :: ReadPrec [Line]
Read)

parseLines :: HamletSettings -> String -> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parseLines :: HamletSettings
-> String
-> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parseLines HamletSettings
set String
s =
    case Parsec
  String () (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
-> String
-> String
-> Either
     ParseError (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec
  String () (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parser String
"[Hamlet input]" String
s of
        Left ParseError
e -> String
-> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
forall v. String -> Result v
Error (String
 -> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)]))
-> String
-> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
        Right (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
x -> (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
-> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
forall a. a -> Result a
Ok (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
x
  where
    parser :: Parsec
  String () (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parser = do
        mnewline <- ParsecT String () Identity (Maybe NewlineStyle)
parseNewline
        let set' =
                case Maybe NewlineStyle
mnewline of
                    Maybe NewlineStyle
Nothing ->
                        case HamletSettings -> NewlineStyle
hamletNewlines HamletSettings
set of
                            NewlineStyle
DefaultNewlineStyle -> HamletSettings
set { hamletNewlines = AlwaysNewlines }
                            NewlineStyle
_ -> HamletSettings
set
                    Just NewlineStyle
n -> HamletSettings
set { hamletNewlines = n }
        res <- many (parseLine set')
        return (mnewline, set', res)

    parseNewline :: ParsecT String () Identity (Maybe NewlineStyle)
parseNewline =
        (GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity () -> ParsecT String () Identity [()]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
eol' ParsecT String () Identity [()]
-> GenParser Char () String -> GenParser Char () String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () String
spaceTabs GenParser Char () String
-> GenParser Char () String -> GenParser Char () String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$newline ") GenParser Char () String
-> ParsecT String () Identity (Maybe NewlineStyle)
-> ParsecT String () Identity (Maybe NewlineStyle)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity (Maybe NewlineStyle)
forall {u}. ParsecT String u Identity (Maybe NewlineStyle)
parseNewline' ParsecT String () Identity (Maybe NewlineStyle)
-> (Maybe NewlineStyle
    -> ParsecT String () Identity (Maybe NewlineStyle))
-> ParsecT String () Identity (Maybe NewlineStyle)
forall a b.
ParsecT String () Identity a
-> (a -> ParsecT String () Identity b)
-> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe NewlineStyle
nl -> ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
eol' ParsecT String () Identity ()
-> ParsecT String () Identity (Maybe NewlineStyle)
-> ParsecT String () Identity (Maybe NewlineStyle)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe NewlineStyle
-> ParsecT String () Identity (Maybe NewlineStyle)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NewlineStyle
nl) ParsecT String () Identity (Maybe NewlineStyle)
-> ParsecT String () Identity (Maybe NewlineStyle)
-> ParsecT String () Identity (Maybe NewlineStyle)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        Maybe NewlineStyle
-> ParsecT String () Identity (Maybe NewlineStyle)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NewlineStyle
forall a. Maybe a
Nothing
    parseNewline' :: ParsecT String u Identity (Maybe NewlineStyle)
parseNewline' =
        (GenParser Char u String -> GenParser Char u String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char u String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"always") GenParser Char u String
-> ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe NewlineStyle
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NewlineStyle -> Maybe NewlineStyle
forall a. a -> Maybe a
Just NewlineStyle
AlwaysNewlines)) ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        (GenParser Char u String -> GenParser Char u String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char u String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"never") GenParser Char u String
-> ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe NewlineStyle
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NewlineStyle -> Maybe NewlineStyle
forall a. a -> Maybe a
Just NewlineStyle
NoNewlines)) ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
        (GenParser Char u String -> GenParser Char u String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char u String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"text") GenParser Char u String
-> ParsecT String u Identity (Maybe NewlineStyle)
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe NewlineStyle
-> ParsecT String u Identity (Maybe NewlineStyle)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NewlineStyle -> Maybe NewlineStyle
forall a. a -> Maybe a
Just NewlineStyle
NewlinesText))

    eol' :: ParsecT String u Identity ()
eol' = (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

parseLine :: HamletSettings -> Parser (Int, Line)
parseLine :: HamletSettings -> ParsecT String () Identity (Int, Line)
parseLine HamletSettings
set = do
    ss <- ([Int] -> Int)
-> ParsecT String () Identity [Int]
-> ParsecT String () Identity Int
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (ParsecT String () Identity [Int]
 -> ParsecT String () Identity Int)
-> ParsecT String () Identity [Int]
-> ParsecT String () Identity Int
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Int -> ParsecT String () Identity [Int]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT String () Identity Char
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String () Identity Int
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1) ParsecT String () Identity Int
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                           (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t' ParsecT String () Identity Char
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String () Identity Int
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Tabs are not allowed in Hamlet indentation"))
    x <- doctype <|>
         doctypeDollar <|>
         comment <|>
         ssiInclude <|>
         htmlComment <|>
         doctypeRaw <|>
         backslash <|>
         controlIf <|>
         controlElseIf <|>
         (try (string "$else") >> spaceTabs >> eol >> return LineElse) <|>
         controlMaybe <|>
         (try (string "$nothing") >> spaceTabs >> eol >> return LineNothing) <|>
         controlForall <|>
         controlWith <|>
         controlCase <|>
         controlOf <|>
         angle <|>
         invalidDollar <|>
         (eol' >> return (LineContent [] True)) <|>
         (do
            (cs, avoidNewLines) <- content InContent
            isEof <- (eof >> return True) <|> return False
            if null cs && ss == 0 && isEof
                then fail "End of Hamlet template"
                else return $ LineContent cs avoidNewLines)
    return (ss, x)
  where
    eol' :: ParsecT String u Identity ()
eol' = (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    eol :: ParsecT String u Identity ()
eol = ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
eol'
    doctype :: ParsecT String st Identity Line
doctype = do
        GenParser Char st () -> GenParser Char st ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st () -> GenParser Char st ())
-> GenParser Char st () -> GenParser Char st ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"!!!" ParsecT String st Identity String
-> GenParser Char st () -> GenParser Char st ()
forall a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char st ()
forall {u}. ParsecT String u Identity ()
eol
        Line -> ParsecT String st Identity Line
forall a. a -> ParsecT String st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Line -> ParsecT String st Identity Line)
-> Line -> ParsecT String st Identity Line
forall a b. (a -> b) -> a -> b
$ [Content] -> Bool -> Line
LineContent [String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ HamletSettings -> String
hamletDoctype HamletSettings
set String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"] Bool
True
    doctypeDollar :: ParsecT String st Identity Line
doctypeDollar = do
        _ <- GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$doctype "
        name <- many $ noneOf "\r\n"
        eol
        case lookup name $ hamletDoctypeNames set of
            Maybe String
Nothing -> String -> ParsecT String st Identity Line
forall a. String -> ParsecT String st Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String st Identity Line)
-> String -> ParsecT String st Identity Line
forall a b. (a -> b) -> a -> b
$ String
"Unknown doctype name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
            Just String
val -> Line -> ParsecT String st Identity Line
forall a. a -> ParsecT String st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Line -> ParsecT String st Identity Line)
-> Line -> ParsecT String st Identity Line
forall a b. (a -> b) -> a -> b
$ [Content] -> Bool -> Line
LineContent [String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ String
val String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"] Bool
True

    doctypeRaw :: ParsecT String st Identity Line
doctypeRaw = do
        x <- GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<!"
        y <- many $ noneOf "\r\n"
        eol
        return $ LineContent [ContentRaw $ concat [x, y, "\n"]] True

    invalidDollar :: ParsecT String u Identity b
invalidDollar = do
        _ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
        fail "Received a command I did not understand. If you wanted a literal $, start the line with a backslash."
    comment :: ParsecT String st Identity Line
comment = do
        _ <- GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$#"
        _ <- many $ noneOf "\r\n"
        eol
        return $ LineContent [] True
    ssiInclude :: ParsecT String st Identity Line
ssiInclude = do
        x <- GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<!--#"
        y <- many $ noneOf "\r\n"
        eol
        return $ LineContent [ContentRaw $ x ++ y] False
    htmlComment :: ParsecT String st Identity Line
htmlComment = do
        _ <- GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<!--"
        _ <- manyTill anyChar $ try $ string "-->"
        x <- many nonComments
        eol
        return $ LineContent [ContentRaw $ concat x] False {- FIXME -} -- FIXME handle variables?
    nonComments :: ParsecT String u Identity String
nonComments = (ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\r\n<") ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
        _ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
        (do
            _ <- try $ string "!--"
            _ <- manyTill anyChar $ try $ string "-->"
            return "") <|> return "<")
    backslash :: ParsecT String u Identity Line
backslash = do
        _ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
        (eol >> return (LineContent [ContentRaw "\n"] True))
            <|> (uncurry LineContent <$> content InContent)
    controlIf :: ParsecT String () Identity Line
controlIf = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$if"
        spaces
        x <- parseDeref
        _ <- spaceTabs
        eol
        return $ LineIf x
    controlElseIf :: ParsecT String () Identity Line
controlElseIf = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$elseif"
        spaces
        x <- parseDeref
        _ <- spaceTabs
        eol
        return $ LineElseIf x
    binding :: ParsecT String () Identity (Deref, Binding)
binding = do
        y <- Parser Binding
identPattern
        spaces
        _ <- string "<-"
        spaces
        x <- parseDeref
        _ <- spaceTabs
        return (x,y)
    bindingSep :: GenParser Char () String
bindingSep = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT String () Identity Char
-> GenParser Char () String -> GenParser Char () String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () String
spaceTabs
    controlMaybe :: ParsecT String () Identity Line
controlMaybe = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$maybe"
        spaces
        (x,y) <- binding
        eol
        return $ LineMaybe x y
    controlForall :: ParsecT String () Identity Line
controlForall = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$forall"
        spaces
        (x,y) <- binding
        eol
        return $ LineForall x y
    controlWith :: ParsecT String () Identity Line
controlWith = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$with"
        spaces
        bindings <- (binding `sepBy` bindingSep) `endBy` eol
        return $ LineWith $ concat bindings -- concat because endBy returns a [[(Deref,Ident)]]
    controlCase :: ParsecT String () Identity Line
controlCase = do
        _ <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$case"
        spaces
        x <- parseDeref
        _ <- spaceTabs
        eol
        return $ LineCase x
    controlOf :: ParsecT String () Identity Line
controlOf = do
        _   <- GenParser Char () String -> GenParser Char () String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$of"
        spaces
        x <- identPattern
        _   <- spaceTabs
        eol
        return $ LineOf x
    content :: ContentRule -> ParsecT String u Identity ([Content], Bool)
content ContentRule
cr = do
        x <- ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity [(Content, Bool)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity (Content, Bool)
 -> ParsecT String u Identity [(Content, Bool)])
-> ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity [(Content, Bool)]
forall a b. (a -> b) -> a -> b
$ ContentRule -> ParsecT String u Identity (Content, Bool)
forall {u}.
ContentRule -> ParsecT String u Identity (Content, Bool)
content' ContentRule
cr
        case cr of
            ContentRule
InQuotes -> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
            ContentRule
NotInQuotes -> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ContentRule
NotInQuotesAttr -> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ContentRule
InContent -> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
eol
        return (cc $ map fst x, any snd x)
      where
        cc :: [Content] -> [Content]
cc [] = []
        cc (ContentRaw String
a:ContentRaw String
b:[Content]
c) = [Content] -> [Content]
cc ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
c
        cc (Content
a:[Content]
b) = Content
a Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
cc [Content]
b

    content' :: ContentRule -> ParsecT String u Identity (Content, Bool)
content' ContentRule
cr =     ContentRule -> ParsecT String u Identity (Content, Bool)
forall {u}.
ContentRule -> ParsecT String u Identity (Content, Bool)
contentHash ContentRule
cr
                  ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (Content, Bool)
forall {a}. ParsecT String a Identity (Content, Bool)
contentAt
                  ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (Content, Bool)
forall {a}. ParsecT String a Identity (Content, Bool)
contentCaret
                  ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (Content, Bool)
forall {a}. ParsecT String a Identity (Content, Bool)
contentUnder
                  ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
-> ParsecT String u Identity (Content, Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ContentRule -> ParsecT String u Identity (Content, Bool)
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
ContentRule -> ParsecT s u m (Content, Bool)
contentReg' ContentRule
cr
    contentHash :: ContentRule -> ParsecT String a Identity (Content, Bool)
contentHash ContentRule
cr = do
        x <- UserParser a (Either String Deref)
forall a. UserParser a (Either String Deref)
parseHash
        case x of
            Left String
"#" -> case ContentRule
cr of
                          ContentRule
NotInQuotes -> String -> ParsecT String a Identity (Content, Bool)
forall a. String -> ParsecT String a Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected hash at end of line, got Id"
                          ContentRule
_ -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Content
ContentRaw String
"#", Bool
False)
            Left String
str -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Content
ContentRaw String
str, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str)
            Right Deref
deref -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Deref -> Content
ContentVar Deref
deref, Bool
False)
    contentAt :: ParsecT String a Identity (Content, Bool)
contentAt = do
        x <- UserParser a (Either String (Deref, Bool))
forall a. UserParser a (Either String (Deref, Bool))
parseAt
        return $ case x of
                    Left String
str -> (String -> Content
ContentRaw String
str, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str)
                    Right (Deref
s, Bool
y) -> (Bool -> Deref -> Content
ContentUrl Bool
y Deref
s, Bool
False)
    contentCaret :: ParsecT String a Identity (Content, Bool)
contentCaret = do
        x <- UserParser a (Either String Deref)
forall a. UserParser a (Either String Deref)
parseCaret
        case x of
            Left String
str -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Content
ContentRaw String
str, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str)
            Right Deref
deref -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Deref -> Content
ContentEmbed Deref
deref, Bool
False)
    contentUnder :: ParsecT String a Identity (Content, Bool)
contentUnder = do
        x <- UserParser a (Either String Deref)
forall a. UserParser a (Either String Deref)
parseUnder
        case x of
            Left String
str -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Content
ContentRaw String
str, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str)
            Right Deref
deref -> (Content, Bool) -> ParsecT String a Identity (Content, Bool)
forall a. a -> ParsecT String a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Deref -> Content
ContentMsg Deref
deref, Bool
False)
    contentReg' :: ContentRule -> ParsecT s u m (Content, Bool)
contentReg' ContentRule
x = ((Content -> Bool -> (Content, Bool))
-> Bool -> Content -> (Content, Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Bool
False) (Content -> (Content, Bool))
-> ParsecT s u m Content -> ParsecT s u m (Content, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentRule -> ParsecT s u m Content
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
ContentRule -> ParsecT s u m Content
contentReg ContentRule
x
    contentReg :: ContentRule -> ParsecT s u m Content
contentReg ContentRule
InContent = (String -> Content
ContentRaw (String -> Content) -> (Char -> String) -> Char -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) (Char -> Content) -> ParsecT s u m Char -> ParsecT s u m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"#@^\r\n"
    contentReg ContentRule
NotInQuotes = (String -> Content
ContentRaw (String -> Content) -> (Char -> String) -> Char -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) (Char -> Content) -> ParsecT s u m Char -> ParsecT s u m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"@^#. \t\n\r>"
    contentReg ContentRule
NotInQuotesAttr = (String -> Content
ContentRaw (String -> Content) -> (Char -> String) -> Char -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) (Char -> Content) -> ParsecT s u m Char -> ParsecT s u m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"@^ \t\n\r>"
    contentReg ContentRule
InQuotes = (String -> Content
ContentRaw (String -> Content) -> (Char -> String) -> Char -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) (Char -> Content) -> ParsecT s u m Char -> ParsecT s u m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"#@^\"\n\r"
    tagAttribValue :: ContentRule -> ParsecT String u Identity [Content]
tagAttribValue ContentRule
notInQuotes = do
        cr <- (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT String u Identity Char
-> ParsecT String u Identity ContentRule
-> ParsecT String u Identity ContentRule
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentRule -> ParsecT String u Identity ContentRule
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ContentRule
InQuotes) ParsecT String u Identity ContentRule
-> ParsecT String u Identity ContentRule
-> ParsecT String u Identity ContentRule
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ContentRule -> ParsecT String u Identity ContentRule
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ContentRule
notInQuotes
        fst <$> content cr
    tagIdent :: ParsecT String u Identity TagPiece
tagIdent = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT String u Identity Char
-> ParsecT String u Identity TagPiece
-> ParsecT String u Identity TagPiece
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Content] -> TagPiece
TagIdent ([Content] -> TagPiece)
-> ParsecT String u Identity [Content]
-> ParsecT String u Identity TagPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentRule -> ParsecT String u Identity [Content]
forall {u}. ContentRule -> ParsecT String u Identity [Content]
tagAttribValue ContentRule
NotInQuotes
    tagCond :: ParsecT String u Identity TagPiece
tagCond = do
        d <- ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':') (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':') ParsecT String u Identity Deref
forall a. UserParser a Deref
parseDeref
        tagClass (Just d) <|> tagAttrib (Just d)
    tagClass :: Maybe Deref -> ParsecT String u Identity TagPiece
tagClass Maybe Deref
x = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT String u Identity Char
-> ParsecT String u Identity TagPiece
-> ParsecT String u Identity TagPiece
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Maybe Deref, [Content]) -> TagPiece
TagClass ((Maybe Deref, [Content]) -> TagPiece)
-> ([Content] -> (Maybe Deref, [Content])) -> [Content] -> TagPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,)Maybe Deref
x)) ([Content] -> TagPiece)
-> ParsecT String u Identity [Content]
-> ParsecT String u Identity TagPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentRule -> ParsecT String u Identity [Content]
forall {u}. ContentRule -> ParsecT String u Identity [Content]
tagAttribValue ContentRule
NotInQuotes
    tagAttrib :: Maybe Deref -> ParsecT String u Identity TagPiece
tagAttrib Maybe Deref
cond = do
        s <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t=\r\n><"
        v <- (char '=' >> Just <$> tagAttribValue NotInQuotesAttr) <|> return Nothing
        return $ TagAttrib (cond, s, v)

    tagAttrs :: ParsecT String u Identity TagPiece
tagAttrs = do
        _ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
        d <- between (char '{') (char '}') parseDeref
        return $ TagAttribs d

    tag' :: [TagPiece]
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
tag' = (TagPiece
 -> (String, [(Maybe Deref, String, Maybe [Content])],
     [(Maybe Deref, [Content])], [Deref])
 -> (String, [(Maybe Deref, String, Maybe [Content])],
     [(Maybe Deref, [Content])], [Deref]))
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
-> [TagPiece]
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TagPiece
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
tag'' (String
"div", [], [], [])
    tag'' :: TagPiece
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
-> (String, [(Maybe Deref, String, Maybe [Content])],
    [(Maybe Deref, [Content])], [Deref])
tag'' (TagName String
s) (String
_, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as) = (String
s, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as)
    tag'' (TagIdent [Content]
s) (String
x, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as) = (String
x, (Maybe Deref
forall a. Maybe a
Nothing, String
"id", [Content] -> Maybe [Content]
forall a. a -> Maybe a
Just [Content]
s) (Maybe Deref, String, Maybe [Content])
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, String, Maybe [Content])]
forall a. a -> [a] -> [a]
: [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as)
    tag'' (TagClass (Maybe Deref, [Content])
s) (String
x, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as) = (String
x, [(Maybe Deref, String, Maybe [Content])]
y, (Maybe Deref, [Content])
s (Maybe Deref, [Content])
-> [(Maybe Deref, [Content])] -> [(Maybe Deref, [Content])]
forall a. a -> [a] -> [a]
: [(Maybe Deref, [Content])]
z, [Deref]
as)
    tag'' (TagAttrib (Maybe Deref, String, Maybe [Content])
s) (String
x, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as) = (String
x, (Maybe Deref, String, Maybe [Content])
s (Maybe Deref, String, Maybe [Content])
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, String, Maybe [Content])]
forall a. a -> [a] -> [a]
: [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as)
    tag'' (TagAttribs Deref
s) (String
x, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, [Deref]
as) = (String
x, [(Maybe Deref, String, Maybe [Content])]
y, [(Maybe Deref, [Content])]
z, Deref
s Deref -> [Deref] -> [Deref]
forall a. a -> [a] -> [a]
: [Deref]
as)

    ident :: Parser Ident
    ident :: Parser Ident
ident = do
      i <- ParsecT String () Identity Char -> GenParser Char () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') GenParser Char () String
-> GenParser Char () String -> GenParser Char () String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char
-> GenParser Char () String -> GenParser Char () String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char -> GenParser Char () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherPunctuation)) GenParser Char () String
-> ParsecT String () Identity Char -> GenParser Char () String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')')
      white
      return (Ident i)
     Parser Ident -> String -> Parser Ident
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"identifier"

    parens :: ParsecT String u Identity a -> ParsecT String u Identity a
parens = ParsecT String u Identity ()
-> ParsecT String u Identity ()
-> ParsecT String u Identity a
-> ParsecT String u Identity a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white) (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white)

    brackets :: ParsecT String u Identity a -> ParsecT String u Identity a
brackets = ParsecT String u Identity ()
-> ParsecT String u Identity ()
-> ParsecT String u Identity a
-> ParsecT String u Identity a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white) (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white)

    braces :: ParsecT String u Identity a -> ParsecT String u Identity a
braces = ParsecT String u Identity ()
-> ParsecT String u Identity ()
-> ParsecT String u Identity a
-> ParsecT String u Identity a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white) (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white)

    comma :: ParsecT String u Identity ()
comma = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white

    atsign :: ParsecT String u Identity ()
atsign = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white

    equals :: ParsecT String u Identity ()
equals = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white

    white :: ParsecT String u Identity ()
white = ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '

    wildDots :: ParsecT String u Identity ()
wildDots = String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".." ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
white

    isVariable :: Ident -> Bool
isVariable (Ident (Char
x:String
_)) = Bool -> Bool
not (Char -> Bool
isUpper Char
x)
    isVariable (Ident []) = String -> Bool
forall a. HasCallStack => String -> a
error String
"isVariable: bad identifier"

    isConstructor :: Ident -> Bool
isConstructor (Ident (Char
x:String
_)) = Char -> Bool
isUpper Char
x Bool -> Bool -> Bool
|| Char -> GeneralCategory
generalCategory Char
x GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
OtherPunctuation
    isConstructor (Ident []) = String -> Bool
forall a. HasCallStack => String -> a
error String
"isConstructor: bad identifier"

    identPattern :: Parser Binding
    identPattern :: Parser Binding
identPattern = Bool -> Parser Binding
gcon Bool
True Parser Binding -> Parser Binding -> Parser Binding
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Binding
apat
      where
      apat :: Parser Binding
apat = [Parser Binding] -> Parser Binding
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ Parser Binding
varpat
        , Bool -> Parser Binding
gcon Bool
False
        , Parser Binding -> Parser Binding
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
parens Parser Binding
tuplepat
        , Parser Binding -> Parser Binding
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
brackets Parser Binding
listpat
        ]

      varpat :: Parser Binding
varpat = do
        v <- Parser Ident -> Parser Ident
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser Ident -> Parser Ident) -> Parser Ident -> Parser Ident
forall a b. (a -> b) -> a -> b
$ do v <- Parser Ident
ident
                      guard (isVariable v)
                      return v
        option (BindVar v) $ do
          atsign
          b <- apat
          return (BindAs v b)
       Parser Binding -> String -> Parser Binding
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"variable"

      gcon :: Bool -> Parser Binding
      gcon :: Bool -> Parser Binding
gcon Bool
allowArgs = do
        c <- GenParser Char () DataConstr -> GenParser Char () DataConstr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () DataConstr -> GenParser Char () DataConstr)
-> GenParser Char () DataConstr -> GenParser Char () DataConstr
forall a b. (a -> b) -> a -> b
$ do c <- GenParser Char () DataConstr
dataConstr
                      return c
        choice
          [ record c
          , fmap (BindConstr c) (guard allowArgs >> many apat)
          , return (BindConstr c [])
          ]
       Parser Binding -> String -> Parser Binding
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"constructor"

      dataConstr :: GenParser Char () DataConstr
dataConstr = do
        p <- GenParser Char () String
dcPiece
        ps <- many dcPieces
        return $ toDataConstr p ps

      dcPiece :: GenParser Char () String
dcPiece = do
        x@(Ident y) <- Parser Ident
ident
        guard $ isConstructor x
        return y

      dcPieces :: GenParser Char () String
dcPieces = do
        _ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        dcPiece

      toDataConstr :: String -> [String] -> DataConstr
toDataConstr String
x [] = Ident -> DataConstr
DCUnqualified (Ident -> DataConstr) -> Ident -> DataConstr
forall a b. (a -> b) -> a -> b
$ String -> Ident
Ident String
x
      toDataConstr String
x (String
y:[String]
ys) =
          ([String] -> [String]) -> String -> [String] -> DataConstr
go (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) String
y [String]
ys
        where
          go :: ([String] -> [String]) -> String -> [String] -> DataConstr
go [String] -> [String]
front String
next [] = Module -> Ident -> DataConstr
DCQualified ([String] -> Module
Module ([String] -> Module) -> [String] -> Module
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
front []) (String -> Ident
Ident String
next)
          go [String] -> [String]
front String
next (String
rest:[String]
rests) = ([String] -> [String]) -> String -> [String] -> DataConstr
go ([String] -> [String]
front ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
nextString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) String
rest [String]
rests

      record :: DataConstr -> Parser Binding
record DataConstr
c = Parser Binding -> Parser Binding
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
braces (Parser Binding -> Parser Binding)
-> Parser Binding -> Parser Binding
forall a b. (a -> b) -> a -> b
$ do
        (fields, wild) <- ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([], Bool
False) (ParsecT String () Identity ([(Ident, Binding)], Bool)
 -> ParsecT String () Identity ([(Ident, Binding)], Bool))
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity ([(Ident, Binding)], Bool)
go
        return (BindRecord c fields wild)
        where
        go :: ParsecT String () Identity ([(Ident, Binding)], Bool)
go = (ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
wildDots ParsecT String () Identity ()
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Bool
True))
           ParsecT String () Identity ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
-> ParsecT String () Identity ([(Ident, Binding)], Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do x         <- ParsecT String () Identity (Ident, Binding)
recordField
                   (xs,wild) <- option ([],False) (comma >> go)
                   return (x:xs,wild))

      recordField :: ParsecT String () Identity (Ident, Binding)
recordField = do
        field <- Parser Ident
ident
        p <- option (BindVar field) -- support punning
                    (equals >> identPattern)
        return (field,p)

      tuplepat :: Parser Binding
tuplepat = do
        xs <- Parser Binding
identPattern Parser Binding
-> ParsecT String () Identity ()
-> ParsecT String () Identity [Binding]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy` ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
comma
        return $ case xs of
          [Binding
x] -> Binding
x
          [Binding]
_   -> [Binding] -> Binding
BindTuple [Binding]
xs

      listpat :: Parser Binding
listpat = [Binding] -> Binding
BindList ([Binding] -> Binding)
-> ParsecT String () Identity [Binding] -> Parser Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Binding
identPattern Parser Binding
-> ParsecT String () Identity ()
-> ParsecT String () Identity [Binding]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy` ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
comma

    angle :: ParsecT String u Identity Line
angle = do
        _ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
        name' <- many  $ noneOf " \t.#\r\n!>"
        let name = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' then String
"div" else String
name'
        xs <- many $ try ((many $ oneOf " \t\r\n") >>
              (tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrs <|> tagAttrib Nothing))
        _ <- many $ oneOf " \t\r\n"
        _ <- char '>'
        (c, avoidNewLines) <- content InContent
        let (tn, attr, classes, attrsd) = tag' $ TagName name : xs
        if '/' `elem` tn
          then fail "A tag name may not contain a slash. Perhaps you have a closing tag in your HTML."
          else return $ LineTag tn attr c classes attrsd avoidNewLines

data TagPiece = TagName String
              | TagIdent [Content]
              | TagClass (Maybe Deref, [Content])
              | TagAttrib (Maybe Deref, String, Maybe [Content])
              | TagAttribs Deref
    deriving Int -> TagPiece -> ShowS
[TagPiece] -> ShowS
TagPiece -> String
(Int -> TagPiece -> ShowS)
-> (TagPiece -> String) -> ([TagPiece] -> ShowS) -> Show TagPiece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagPiece -> ShowS
showsPrec :: Int -> TagPiece -> ShowS
$cshow :: TagPiece -> String
show :: TagPiece -> String
$cshowList :: [TagPiece] -> ShowS
showList :: [TagPiece] -> ShowS
Show

data ContentRule = InQuotes | NotInQuotes | NotInQuotesAttr | InContent

data Nest = Nest Line [Nest]

nestLines :: [(Int, Line)] -> [Nest]
nestLines :: [(Int, Line)] -> [Nest]
nestLines [] = []
nestLines ((Int
i, Line
l):[(Int, Line)]
rest) =
    let ([(Int, Line)]
deeper, [(Int, Line)]
rest') = ((Int, Line) -> Bool)
-> [(Int, Line)] -> ([(Int, Line)], [(Int, Line)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(Int
i', Line
_) -> Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i) [(Int, Line)]
rest
     in Line -> [Nest] -> Nest
Nest Line
l ([(Int, Line)] -> [Nest]
nestLines [(Int, Line)]
deeper) Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [(Int, Line)] -> [Nest]
nestLines [(Int, Line)]
rest'

data Doc = DocForall Deref Binding [Doc]
         | DocWith [(Deref, Binding)] [Doc]
         | DocCond [(Deref, [Doc])] (Maybe [Doc])
         | DocMaybe Deref Binding [Doc] (Maybe [Doc])
         | DocCase Deref [(Binding, [Doc])]
         | DocContent Content
    deriving (Int -> Doc -> ShowS
[Doc] -> ShowS
Doc -> String
(Int -> Doc -> ShowS)
-> (Doc -> String) -> ([Doc] -> ShowS) -> Show Doc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Doc -> ShowS
showsPrec :: Int -> Doc -> ShowS
$cshow :: Doc -> String
show :: Doc -> String
$cshowList :: [Doc] -> ShowS
showList :: [Doc] -> ShowS
Show, Doc -> Doc -> Bool
(Doc -> Doc -> Bool) -> (Doc -> Doc -> Bool) -> Eq Doc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Doc -> Doc -> Bool
== :: Doc -> Doc -> Bool
$c/= :: Doc -> Doc -> Bool
/= :: Doc -> Doc -> Bool
Eq, ReadPrec [Doc]
ReadPrec Doc
Int -> ReadS Doc
ReadS [Doc]
(Int -> ReadS Doc)
-> ReadS [Doc] -> ReadPrec Doc -> ReadPrec [Doc] -> Read Doc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Doc
readsPrec :: Int -> ReadS Doc
$creadList :: ReadS [Doc]
readList :: ReadS [Doc]
$creadPrec :: ReadPrec Doc
readPrec :: ReadPrec Doc
$creadListPrec :: ReadPrec [Doc]
readListPrec :: ReadPrec [Doc]
Read, Typeable Doc
Typeable Doc =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Doc -> c Doc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Doc)
-> (Doc -> Constr)
-> (Doc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Doc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doc))
-> ((forall b. Data b => b -> b) -> Doc -> Doc)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r)
-> (forall u. (forall d. Data d => d -> u) -> Doc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Doc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Doc -> m Doc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Doc -> m Doc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Doc -> m Doc)
-> Data Doc
Doc -> Constr
Doc -> DataType
(forall b. Data b => b -> b) -> Doc -> Doc
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Doc -> u
forall u. (forall d. Data d => d -> u) -> Doc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc -> c Doc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc -> c Doc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc -> c Doc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doc
$ctoConstr :: Doc -> Constr
toConstr :: Doc -> Constr
$cdataTypeOf :: Doc -> DataType
dataTypeOf :: Doc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doc)
$cgmapT :: (forall b. Data b => b -> b) -> Doc -> Doc
gmapT :: (forall b. Data b => b -> b) -> Doc -> Doc
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Doc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Doc -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Doc -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Doc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc -> m Doc
Data, Typeable)

nestToDoc :: HamletSettings -> [Nest] -> Result [Doc]
nestToDoc :: HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
_set [] = [Doc] -> Result [Doc]
forall a. a -> Result a
Ok []
nestToDoc HamletSettings
set (Nest (LineForall Deref
d Binding
i) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    rest' <- nestToDoc set rest
    Ok $ DocForall d i inside' : rest'
nestToDoc HamletSettings
set (Nest (LineWith [(Deref, Binding)]
dis) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    rest' <- nestToDoc set rest
    Ok $ DocWith dis inside' : rest'
nestToDoc HamletSettings
set (Nest (LineIf Deref
d) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    (ifs, el, rest') <- parseConds set ((:) (d, inside')) rest
    rest'' <- nestToDoc set rest'
    Ok $ DocCond ifs el : rest''
nestToDoc HamletSettings
set (Nest (LineMaybe Deref
d Binding
i) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    (nothing, rest') <-
        case rest of
            Nest Line
LineNothing [Nest]
ninside:[Nest]
x -> do
                ninside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
ninside
                return (Just ninside', x)
            [Nest]
_ -> (Maybe [Doc], [Nest]) -> Result (Maybe [Doc], [Nest])
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Doc]
forall a. Maybe a
Nothing, [Nest]
rest)
    rest'' <- nestToDoc set rest'
    Ok $ DocMaybe d i inside' nothing : rest''
nestToDoc HamletSettings
set (Nest (LineCase Deref
d) [Nest]
inside:[Nest]
rest) = do
    let getOf :: Nest -> Result (Binding, [Doc])
getOf (Nest (LineOf Binding
x) [Nest]
insideC) = do
            insideC' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
insideC
            Ok (x, insideC')
        getOf Nest
_ = String -> Result (Binding, [Doc])
forall v. String -> Result v
Error String
"Inside a $case there may only be $of.  Use '$of _' for a wildcard."
    cases <- (Nest -> Result (Binding, [Doc]))
-> [Nest] -> Result [(Binding, [Doc])]
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 Nest -> Result (Binding, [Doc])
getOf [Nest]
inside
    rest' <- nestToDoc set rest
    Ok $ DocCase d cases : rest'
nestToDoc HamletSettings
set (Nest (LineTag String
tn [(Maybe Deref, String, Maybe [Content])]
attrs [Content]
content [(Maybe Deref, [Content])]
classes [Deref]
attrsD Bool
avoidNewLine) [Nest]
inside:[Nest]
rest) = do
    let attrFix :: (a, b, b) -> (a, b, [(Maybe a, b)])
attrFix (a
x, b
y, b
z) = (a
x, b
y, [(Maybe a
forall a. Maybe a
Nothing, b
z)])
    let takeClass :: (a, String, Maybe [a]) -> Maybe (a, [a])
takeClass (a
a, String
"class", Maybe [a]
b) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
a, [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [a]
b)
        takeClass (a, String, Maybe [a])
_ = Maybe (a, [a])
forall a. Maybe a
Nothing
    let clazzes :: [(Maybe Deref, [Content])]
clazzes = [(Maybe Deref, [Content])]
classes [(Maybe Deref, [Content])]
-> [(Maybe Deref, [Content])] -> [(Maybe Deref, [Content])]
forall a. [a] -> [a] -> [a]
++ ((Maybe Deref, String, Maybe [Content])
 -> Maybe (Maybe Deref, [Content]))
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, [Content])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Deref, String, Maybe [Content])
-> Maybe (Maybe Deref, [Content])
forall {a} {a}. (a, String, Maybe [a]) -> Maybe (a, [a])
takeClass [(Maybe Deref, String, Maybe [Content])]
attrs
    let notClass :: (a, String, c) -> Bool
notClass (a
_, String
x, c
_) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"class"
    let noclass :: [(Maybe Deref, String, Maybe [Content])]
noclass = ((Maybe Deref, String, Maybe [Content]) -> Bool)
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, String, Maybe [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Deref, String, Maybe [Content]) -> Bool
forall {a} {c}. (a, String, c) -> Bool
notClass [(Maybe Deref, String, Maybe [Content])]
attrs
    let attrs' :: [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
attrs' =
            case [(Maybe Deref, [Content])]
clazzes of
              [] -> ((Maybe Deref, String, Maybe [Content])
 -> (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]))
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Deref, String, Maybe [Content])
-> (Maybe Deref, String, [(Maybe Deref, Maybe [Content])])
forall {a} {b} {b} {a}. (a, b, b) -> (a, b, [(Maybe a, b)])
attrFix [(Maybe Deref, String, Maybe [Content])]
noclass
              [(Maybe Deref, [Content])]
_ -> ([(Maybe Deref, [Content])] -> Maybe Deref
testIncludeClazzes [(Maybe Deref, [Content])]
clazzes, String
"class", ((Maybe Deref, [Content]) -> (Maybe Deref, Maybe [Content]))
-> [(Maybe Deref, [Content])] -> [(Maybe Deref, Maybe [Content])]
forall a b. (a -> b) -> [a] -> [b]
map (([Content] -> Maybe [Content])
-> (Maybe Deref, [Content]) -> (Maybe Deref, Maybe [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Content] -> Maybe [Content]
forall a. a -> Maybe a
Just) [(Maybe Deref, [Content])]
clazzes)
                       (Maybe Deref, String, [(Maybe Deref, Maybe [Content])])
-> [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
-> [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
forall a. a -> [a] -> [a]
: ((Maybe Deref, String, Maybe [Content])
 -> (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]))
-> [(Maybe Deref, String, Maybe [Content])]
-> [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Deref, String, Maybe [Content])
-> (Maybe Deref, String, [(Maybe Deref, Maybe [Content])])
forall {a} {b} {b} {a}. (a, b, b) -> (a, b, [(Maybe a, b)])
attrFix [(Maybe Deref, String, Maybe [Content])]
noclass
    let closeStyle :: CloseStyle
closeStyle =
            if Bool -> Bool
not ([Content] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
content) Bool -> Bool -> Bool
|| Bool -> Bool
not ([Nest] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Nest]
inside)
                then CloseStyle
CloseSeparate
                else HamletSettings -> String -> CloseStyle
hamletCloseStyle HamletSettings
set String
tn
    let end :: Doc
end = case CloseStyle
closeStyle of
                CloseStyle
CloseSeparate ->
                    Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ String
"</" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
                CloseStyle
_ -> Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
""
        seal :: Doc
seal = case CloseStyle
closeStyle of
                 CloseStyle
CloseInside -> Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
"/>"
                 CloseStyle
_ -> Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
">"
        start :: Doc
start = Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tn
        attrs'' :: [Doc]
attrs'' = ((Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc])
-> [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
-> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc]
attrToContent [(Maybe Deref, String, [(Maybe Deref, Maybe [Content])])]
attrs'
        newline' :: Doc
newline' = Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw
                 (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ case HamletSettings -> NewlineStyle
hamletNewlines HamletSettings
set of { NewlineStyle
AlwaysNewlines | Bool -> Bool
not Bool
avoidNewLine -> String
"\n"; NewlineStyle
_ -> String
"" }
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    rest' <- nestToDoc set rest
    Ok $ start
       : attrs''
      ++ map (DocContent . ContentAttrs) attrsD
      ++ seal
       : map DocContent content
      ++ inside'
      ++ end
       : newline'
       : rest'
nestToDoc HamletSettings
set (Nest (LineContent [Content]
content Bool
avoidNewLine) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    rest' <- nestToDoc set rest
    let newline' = Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw
                   (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ case HamletSettings -> NewlineStyle
hamletNewlines HamletSettings
set of { NewlineStyle
NoNewlines -> String
""; NewlineStyle
_ -> if Bool
nextIsContent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
avoidNewLine then String
"\n" else String
"" }
        nextIsContent =
            case ([Nest]
inside, [Nest]
rest) of
                ([], Nest LineContent{} [Nest]
_:[Nest]
_) -> Bool
True
                ([], Nest LineTag{} [Nest]
_:[Nest]
_) -> Bool
True
                ([Nest], [Nest])
_ -> Bool
False
    Ok $ map DocContent content ++ newline':inside' ++ rest'
nestToDoc HamletSettings
_set (Nest (LineElseIf Deref
_) [Nest]
_:[Nest]
_) = String -> Result [Doc]
forall v. String -> Result v
Error String
"Unexpected elseif"
nestToDoc HamletSettings
_set (Nest Line
LineElse [Nest]
_:[Nest]
_) = String -> Result [Doc]
forall v. String -> Result v
Error String
"Unexpected else"
nestToDoc HamletSettings
_set (Nest Line
LineNothing [Nest]
_:[Nest]
_) = String -> Result [Doc]
forall v. String -> Result v
Error String
"Unexpected nothing"
nestToDoc HamletSettings
_set (Nest (LineOf Binding
_) [Nest]
_:[Nest]
_) = String -> Result [Doc]
forall v. String -> Result v
Error String
"Unexpected 'of' (did you forget a $case?)"

compressDoc :: [Doc] -> [Doc]
compressDoc :: [Doc] -> [Doc]
compressDoc [] = []
compressDoc (DocForall Deref
d Binding
i [Doc]
doc:[Doc]
rest) =
    Deref -> Binding -> [Doc] -> Doc
DocForall Deref
d Binding
i ([Doc] -> [Doc]
compressDoc [Doc]
doc) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc (DocWith [(Deref, Binding)]
dis [Doc]
doc:[Doc]
rest) =
    [(Deref, Binding)] -> [Doc] -> Doc
DocWith [(Deref, Binding)]
dis ([Doc] -> [Doc]
compressDoc [Doc]
doc) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc (DocMaybe Deref
d Binding
i [Doc]
doc Maybe [Doc]
mnothing:[Doc]
rest) =
    Deref -> Binding -> [Doc] -> Maybe [Doc] -> Doc
DocMaybe Deref
d Binding
i ([Doc] -> [Doc]
compressDoc [Doc]
doc) (([Doc] -> [Doc]) -> Maybe [Doc] -> Maybe [Doc]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> [Doc]
compressDoc Maybe [Doc]
mnothing)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc (DocCond [(Deref
a, [Doc]
x)] Maybe [Doc]
Nothing:DocCond [(Deref
b, [Doc]
y)] Maybe [Doc]
Nothing:[Doc]
rest)
    | Deref
a Deref -> Deref -> Bool
forall a. Eq a => a -> a -> Bool
== Deref
b = [Doc] -> [Doc]
compressDoc ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [(Deref, [Doc])] -> Maybe [Doc] -> Doc
DocCond [(Deref
a, [Doc]
x [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
y)] Maybe [Doc]
forall a. Maybe a
Nothing Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
rest
compressDoc (DocCond [(Deref, [Doc])]
x Maybe [Doc]
y:[Doc]
rest) =
    [(Deref, [Doc])] -> Maybe [Doc] -> Doc
DocCond (((Deref, [Doc]) -> (Deref, [Doc]))
-> [(Deref, [Doc])] -> [(Deref, [Doc])]
forall a b. (a -> b) -> [a] -> [b]
map (([Doc] -> [Doc]) -> (Deref, [Doc]) -> (Deref, [Doc])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Doc] -> [Doc]
compressDoc) [(Deref, [Doc])]
x) ([Doc] -> [Doc]
compressDoc ([Doc] -> [Doc]) -> Maybe [Doc] -> Maybe [Doc]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe [Doc]
y)
    Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc (DocCase Deref
d [(Binding, [Doc])]
cs:[Doc]
rest) =
    Deref -> [(Binding, [Doc])] -> Doc
DocCase Deref
d (((Binding, [Doc]) -> (Binding, [Doc]))
-> [(Binding, [Doc])] -> [(Binding, [Doc])]
forall a b. (a -> b) -> [a] -> [b]
map (([Doc] -> [Doc]) -> (Binding, [Doc]) -> (Binding, [Doc])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Doc] -> [Doc]
compressDoc) [(Binding, [Doc])]
cs) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc (DocContent (ContentRaw String
""):[Doc]
rest) = [Doc] -> [Doc]
compressDoc [Doc]
rest
compressDoc ( DocContent (ContentRaw String
x)
            : DocContent (ContentRaw String
y)
            : [Doc]
rest
            ) = [Doc] -> [Doc]
compressDoc ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
rest
compressDoc (DocContent Content
x:[Doc]
rest) = Content -> Doc
DocContent Content
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
compressDoc [Doc]
rest

parseDoc :: HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc :: HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc HamletSettings
set String
s = do
    (mnl, set', ls) <- HamletSettings
-> String
-> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)])
parseLines HamletSettings
set String
s
    let notEmpty (a
_, LineContent [] Bool
_) = Bool
False
        notEmpty (a, Line)
_ = Bool
True
    let ns = [(Int, Line)] -> [Nest]
nestLines ([(Int, Line)] -> [Nest]) -> [(Int, Line)] -> [Nest]
forall a b. (a -> b) -> a -> b
$ ((Int, Line) -> Bool) -> [(Int, Line)] -> [(Int, Line)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Line) -> Bool
forall {a}. (a, Line) -> Bool
notEmpty [(Int, Line)]
ls
    ds <- nestToDoc set' ns
    return (mnl, compressDoc ds)

attrToContent :: (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc]
attrToContent :: (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc]
attrToContent (Just Deref
cond, String
k, [(Maybe Deref, Maybe [Content])]
v) =
    [[(Deref, [Doc])] -> Maybe [Doc] -> Doc
DocCond [(Deref
cond, (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc]
attrToContent (Maybe Deref
forall a. Maybe a
Nothing, String
k, [(Maybe Deref, Maybe [Content])]
v))] Maybe [Doc]
forall a. Maybe a
Nothing]
attrToContent (Maybe Deref
Nothing, String
k, []) = [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
k]
attrToContent (Maybe Deref
Nothing, String
k, [(Maybe Deref
Nothing, Maybe [Content]
Nothing)]) = [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
k]
attrToContent (Maybe Deref
Nothing, String
k, [(Maybe Deref
Nothing, Just [Content]
v)]) =
    Content -> Doc
DocContent (String -> Content
ContentRaw (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=\""))
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
DocContent [Content]
v
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
"\""]
attrToContent (Maybe Deref
Nothing, String
k, [(Maybe Deref, Maybe [Content])]
v) = -- only for class
      Content -> Doc
DocContent (String -> Content
ContentRaw (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=\""))
    Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ((Maybe Deref, Maybe [Content]) -> [Doc])
-> [(Maybe Deref, Maybe [Content])] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Deref, Maybe [Content]) -> [Doc]
go ([(Maybe Deref, Maybe [Content])]
-> [(Maybe Deref, Maybe [Content])]
forall a. HasCallStack => [a] -> [a]
init [(Maybe Deref, Maybe [Content])]
v)
    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Maybe Deref, Maybe [Content]) -> [Doc]
go' ([(Maybe Deref, Maybe [Content])] -> (Maybe Deref, Maybe [Content])
forall a. HasCallStack => [a] -> a
last [(Maybe Deref, Maybe [Content])]
v)
    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
"\""]
  where
    go :: (Maybe Deref, Maybe [Content]) -> [Doc]
go (Maybe Deref
Nothing, Maybe [Content]
x) = (Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
DocContent ([Content] -> Maybe [Content] -> [Content]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Content]
x) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
" "]
    go (Just Deref
b, Maybe [Content]
x) =
        [ [(Deref, [Doc])] -> Maybe [Doc] -> Doc
DocCond
            [(Deref
b, (Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
DocContent ([Content] -> Maybe [Content] -> [Content]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Content]
x) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Content -> Doc
DocContent (Content -> Doc) -> Content -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Content
ContentRaw String
" "])]
            Maybe [Doc]
forall a. Maybe a
Nothing
        ]
    go' :: (Maybe Deref, Maybe [Content]) -> [Doc]
go' (Maybe Deref
Nothing, Maybe [Content]
x) = [Doc] -> ([Content] -> [Doc]) -> Maybe [Content] -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
DocContent) Maybe [Content]
x
    go' (Just Deref
b, Maybe [Content]
x) =
        [ [(Deref, [Doc])] -> Maybe [Doc] -> Doc
DocCond
            [(Deref
b, [Doc] -> ([Content] -> [Doc]) -> Maybe [Content] -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
DocContent) Maybe [Content]
x)]
            Maybe [Doc]
forall a. Maybe a
Nothing
        ]

-- | Settings for parsing of a hamlet document.
data HamletSettings = HamletSettings
    {
      -- | The value to replace a \"!!!\" with. Do not include the trailing
      -- newline.
      HamletSettings -> String
hamletDoctype :: String
      -- | Should we add newlines to the output, making it more human-readable?
      --  Useful for client-side debugging but may alter browser page layout.
    , HamletSettings -> NewlineStyle
hamletNewlines :: NewlineStyle
      -- | How a tag should be closed. Use this to switch between HTML, XHTML
      -- or even XML output.
    , HamletSettings -> String -> CloseStyle
hamletCloseStyle :: String -> CloseStyle
      -- | Mapping from short names in \"$doctype\" statements to full doctype.
    , HamletSettings -> [(String, String)]
hamletDoctypeNames :: [(String, String)]
    }
    deriving (forall (m :: * -> *). Quote m => HamletSettings -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    HamletSettings -> Code m HamletSettings)
-> Lift HamletSettings
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => HamletSettings -> m Exp
forall (m :: * -> *).
Quote m =>
HamletSettings -> Code m HamletSettings
$clift :: forall (m :: * -> *). Quote m => HamletSettings -> m Exp
lift :: forall (m :: * -> *). Quote m => HamletSettings -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
HamletSettings -> Code m HamletSettings
liftTyped :: forall (m :: * -> *).
Quote m =>
HamletSettings -> Code m HamletSettings
Lift

data NewlineStyle = NoNewlines -- ^ never add newlines
                  | NewlinesText -- ^ add newlines between consecutive text lines
                  | AlwaysNewlines -- ^ add newlines everywhere
                  | DefaultNewlineStyle
    deriving (Int -> NewlineStyle -> ShowS
[NewlineStyle] -> ShowS
NewlineStyle -> String
(Int -> NewlineStyle -> ShowS)
-> (NewlineStyle -> String)
-> ([NewlineStyle] -> ShowS)
-> Show NewlineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewlineStyle -> ShowS
showsPrec :: Int -> NewlineStyle -> ShowS
$cshow :: NewlineStyle -> String
show :: NewlineStyle -> String
$cshowList :: [NewlineStyle] -> ShowS
showList :: [NewlineStyle] -> ShowS
Show, (forall (m :: * -> *). Quote m => NewlineStyle -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    NewlineStyle -> Code m NewlineStyle)
-> Lift NewlineStyle
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => NewlineStyle -> m Exp
forall (m :: * -> *).
Quote m =>
NewlineStyle -> Code m NewlineStyle
$clift :: forall (m :: * -> *). Quote m => NewlineStyle -> m Exp
lift :: forall (m :: * -> *). Quote m => NewlineStyle -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
NewlineStyle -> Code m NewlineStyle
liftTyped :: forall (m :: * -> *).
Quote m =>
NewlineStyle -> Code m NewlineStyle
Lift)

instance Lift (String -> CloseStyle) where
    lift :: forall (m :: * -> *). Quote m => (String -> CloseStyle) -> m Exp
lift String -> CloseStyle
_ = [|\s -> htmlCloseStyle s|]
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped :: forall (m :: * -> *).
Quote m =>
(String -> CloseStyle) -> Code m (String -> CloseStyle)
liftTyped = m Exp -> Code m (String -> CloseStyle)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m (String -> CloseStyle))
-> ((String -> CloseStyle) -> m Exp)
-> (String -> CloseStyle)
-> Code m (String -> CloseStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CloseStyle) -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => (String -> CloseStyle) -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped = unsafeTExpCoerce . lift
#endif


-- See the html specification for a list of all void elements:
-- https://www.w3.org/TR/html/syntax.html#void-elements
htmlEmptyTags :: Set String
htmlEmptyTags :: Set String
htmlEmptyTags = [String] -> Set String
forall a. Eq a => [a] -> Set a
Set.fromAscList
    [ String
"area"
    , String
"base"
    , String
"basefont" -- not html 5
    , String
"br"
    , String
"col"
    , String
"embed"
    , String
"frame"    -- not html 5
    , String
"hr"
    , String
"img"
    , String
"input"
    , String
"isindex"  -- not html 5
    , String
"keygen"
    , String
"link"
    , String
"meta"
    , String
"param"
    , String
"source"
    , String
"track"
    , String
"wbr"
    ]

-- | Defaults settings: HTML5 doctype and HTML-style empty tags.
defaultHamletSettings :: HamletSettings
defaultHamletSettings :: HamletSettings
defaultHamletSettings = String
-> NewlineStyle
-> (String -> CloseStyle)
-> [(String, String)]
-> HamletSettings
HamletSettings String
"<!DOCTYPE html>" NewlineStyle
DefaultNewlineStyle String -> CloseStyle
htmlCloseStyle [(String, String)]
doctypeNames

xhtmlHamletSettings :: HamletSettings
xhtmlHamletSettings :: HamletSettings
xhtmlHamletSettings =
    String
-> NewlineStyle
-> (String -> CloseStyle)
-> [(String, String)]
-> HamletSettings
HamletSettings String
doctype NewlineStyle
DefaultNewlineStyle String -> CloseStyle
xhtmlCloseStyle [(String, String)]
doctypeNames
  where
    doctype :: String
doctype =
      String
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"

htmlCloseStyle :: String -> CloseStyle
htmlCloseStyle :: String -> CloseStyle
htmlCloseStyle String
s =
    if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
s Set String
htmlEmptyTags
        then CloseStyle
NoClose
        else CloseStyle
CloseSeparate

xhtmlCloseStyle :: String -> CloseStyle
xhtmlCloseStyle :: String -> CloseStyle
xhtmlCloseStyle String
s =
    if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
s Set String
htmlEmptyTags
        then CloseStyle
CloseInside
        else CloseStyle
CloseSeparate

data CloseStyle = NoClose | CloseInside | CloseSeparate

parseConds :: HamletSettings
           -> ([(Deref, [Doc])] -> [(Deref, [Doc])])
           -> [Nest]
           -> Result ([(Deref, [Doc])], Maybe [Doc], [Nest])
parseConds :: HamletSettings
-> ([(Deref, [Doc])] -> [(Deref, [Doc])])
-> [Nest]
-> Result ([(Deref, [Doc])], Maybe [Doc], [Nest])
parseConds HamletSettings
set [(Deref, [Doc])] -> [(Deref, [Doc])]
front (Nest Line
LineElse [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    Ok (front [], Just inside', rest)
parseConds HamletSettings
set [(Deref, [Doc])] -> [(Deref, [Doc])]
front (Nest (LineElseIf Deref
d) [Nest]
inside:[Nest]
rest) = do
    inside' <- HamletSettings -> [Nest] -> Result [Doc]
nestToDoc HamletSettings
set [Nest]
inside
    parseConds set (front . (:) (d, inside')) rest
parseConds HamletSettings
_ [(Deref, [Doc])] -> [(Deref, [Doc])]
front [Nest]
rest = ([(Deref, [Doc])], Maybe [Doc], [Nest])
-> Result ([(Deref, [Doc])], Maybe [Doc], [Nest])
forall a. a -> Result a
Ok ([(Deref, [Doc])] -> [(Deref, [Doc])]
front [], Maybe [Doc]
forall a. Maybe a
Nothing, [Nest]
rest)

doctypeNames :: [(String, String)]
doctypeNames :: [(String, String)]
doctypeNames =
    [ (String
"5", String
"<!DOCTYPE html>")
    , (String
"html", String
"<!DOCTYPE html>")
    , (String
"1.1", String
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">")
    , (String
"strict", String
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
    ]

data Binding = BindVar Ident
             | BindAs Ident Binding
             | BindConstr DataConstr [Binding]
             | BindTuple [Binding]
             | BindList [Binding]
             | BindRecord DataConstr [(Ident, Binding)] Bool
    deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
/= :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binding -> ShowS
showsPrec :: Int -> Binding -> ShowS
$cshow :: Binding -> String
show :: Binding -> String
$cshowList :: [Binding] -> ShowS
showList :: [Binding] -> ShowS
Show, ReadPrec [Binding]
ReadPrec Binding
Int -> ReadS Binding
ReadS [Binding]
(Int -> ReadS Binding)
-> ReadS [Binding]
-> ReadPrec Binding
-> ReadPrec [Binding]
-> Read Binding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Binding
readsPrec :: Int -> ReadS Binding
$creadList :: ReadS [Binding]
readList :: ReadS [Binding]
$creadPrec :: ReadPrec Binding
readPrec :: ReadPrec Binding
$creadListPrec :: ReadPrec [Binding]
readListPrec :: ReadPrec [Binding]
Read, Typeable Binding
Typeable Binding =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Binding -> c Binding)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Binding)
-> (Binding -> Constr)
-> (Binding -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Binding))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Binding))
-> ((forall b. Data b => b -> b) -> Binding -> Binding)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Binding -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Binding -> r)
-> (forall u. (forall d. Data d => d -> u) -> Binding -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Binding -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Binding -> m Binding)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Binding -> m Binding)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Binding -> m Binding)
-> Data Binding
Binding -> Constr
Binding -> DataType
(forall b. Data b => b -> b) -> Binding -> Binding
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Binding -> u
forall u. (forall d. Data d => d -> u) -> Binding -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Binding
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Binding -> c Binding
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Binding)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Binding)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Binding -> c Binding
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Binding -> c Binding
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Binding
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Binding
$ctoConstr :: Binding -> Constr
toConstr :: Binding -> Constr
$cdataTypeOf :: Binding -> DataType
dataTypeOf :: Binding -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Binding)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Binding)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Binding)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Binding)
$cgmapT :: (forall b. Data b => b -> b) -> Binding -> Binding
gmapT :: (forall b. Data b => b -> b) -> Binding -> Binding
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Binding -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Binding -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Binding -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Binding -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Binding -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Binding -> m Binding
Data, Typeable)

data DataConstr = DCQualified Module Ident
                | DCUnqualified Ident
    deriving (DataConstr -> DataConstr -> Bool
(DataConstr -> DataConstr -> Bool)
-> (DataConstr -> DataConstr -> Bool) -> Eq DataConstr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataConstr -> DataConstr -> Bool
== :: DataConstr -> DataConstr -> Bool
$c/= :: DataConstr -> DataConstr -> Bool
/= :: DataConstr -> DataConstr -> Bool
Eq, Int -> DataConstr -> ShowS
[DataConstr] -> ShowS
DataConstr -> String
(Int -> DataConstr -> ShowS)
-> (DataConstr -> String)
-> ([DataConstr] -> ShowS)
-> Show DataConstr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataConstr -> ShowS
showsPrec :: Int -> DataConstr -> ShowS
$cshow :: DataConstr -> String
show :: DataConstr -> String
$cshowList :: [DataConstr] -> ShowS
showList :: [DataConstr] -> ShowS
Show, ReadPrec [DataConstr]
ReadPrec DataConstr
Int -> ReadS DataConstr
ReadS [DataConstr]
(Int -> ReadS DataConstr)
-> ReadS [DataConstr]
-> ReadPrec DataConstr
-> ReadPrec [DataConstr]
-> Read DataConstr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DataConstr
readsPrec :: Int -> ReadS DataConstr
$creadList :: ReadS [DataConstr]
readList :: ReadS [DataConstr]
$creadPrec :: ReadPrec DataConstr
readPrec :: ReadPrec DataConstr
$creadListPrec :: ReadPrec [DataConstr]
readListPrec :: ReadPrec [DataConstr]
Read, Typeable DataConstr
Typeable DataConstr =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DataConstr -> c DataConstr)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DataConstr)
-> (DataConstr -> Constr)
-> (DataConstr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DataConstr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DataConstr))
-> ((forall b. Data b => b -> b) -> DataConstr -> DataConstr)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DataConstr -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DataConstr -> r)
-> (forall u. (forall d. Data d => d -> u) -> DataConstr -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DataConstr -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DataConstr -> m DataConstr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataConstr -> m DataConstr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DataConstr -> m DataConstr)
-> Data DataConstr
DataConstr -> Constr
DataConstr -> DataType
(forall b. Data b => b -> b) -> DataConstr -> DataConstr
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DataConstr -> u
forall u. (forall d. Data d => d -> u) -> DataConstr -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataConstr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataConstr -> c DataConstr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataConstr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataConstr)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataConstr -> c DataConstr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataConstr -> c DataConstr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataConstr
$ctoConstr :: DataConstr -> Constr
toConstr :: DataConstr -> Constr
$cdataTypeOf :: DataConstr -> DataType
dataTypeOf :: DataConstr -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataConstr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataConstr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataConstr)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataConstr)
$cgmapT :: (forall b. Data b => b -> b) -> DataConstr -> DataConstr
gmapT :: (forall b. Data b => b -> b) -> DataConstr -> DataConstr
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataConstr -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataConstr -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataConstr -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataConstr -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataConstr -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataConstr -> m DataConstr
Data, Typeable)

newtype Module = Module [String]
    deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
/= :: Module -> Module -> Bool
Eq, Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Module -> ShowS
showsPrec :: Int -> Module -> ShowS
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> ShowS
showList :: [Module] -> ShowS
Show, ReadPrec [Module]
ReadPrec Module
Int -> ReadS Module
ReadS [Module]
(Int -> ReadS Module)
-> ReadS [Module]
-> ReadPrec Module
-> ReadPrec [Module]
-> Read Module
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Module
readsPrec :: Int -> ReadS Module
$creadList :: ReadS [Module]
readList :: ReadS [Module]
$creadPrec :: ReadPrec Module
readPrec :: ReadPrec Module
$creadListPrec :: ReadPrec [Module]
readListPrec :: ReadPrec [Module]
Read, Typeable Module
Typeable Module =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Module -> c Module)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Module)
-> (Module -> Constr)
-> (Module -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Module))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module))
-> ((forall b. Data b => b -> b) -> Module -> Module)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall u. (forall d. Data d => d -> u) -> Module -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Module -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> Data Module
Module -> Constr
Module -> DataType
(forall b. Data b => b -> b) -> Module -> Module
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
forall u. (forall d. Data d => d -> u) -> Module -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
$ctoConstr :: Module -> Constr
toConstr :: Module -> Constr
$cdataTypeOf :: Module -> DataType
dataTypeOf :: Module -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cgmapT :: (forall b. Data b => b -> b) -> Module -> Module
gmapT :: (forall b. Data b => b -> b) -> Module -> Module
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Module -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Module -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
Data, Typeable)

spaceTabs :: Parser String
spaceTabs :: GenParser Char () String
spaceTabs = ParsecT String () Identity Char -> GenParser Char () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char -> GenParser Char () String)
-> ParsecT String () Identity Char -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"

-- | When using conditional classes, it will often be a single class, e.g.:
--
-- > <div :isHome:.homepage>
--
-- If isHome is False, we do not want any class attribute to be present.
-- However, due to combining multiple classes together, the most obvious
-- implementation would produce a class="". The purpose of this function is to
-- work around that. It does so by checking if all the classes on this tag are
-- optional. If so, it will only include the class attribute if at least one
-- conditional is true.
testIncludeClazzes :: [(Maybe Deref, [Content])] -> Maybe Deref
testIncludeClazzes :: [(Maybe Deref, [Content])] -> Maybe Deref
testIncludeClazzes [(Maybe Deref, [Content])]
cs
    | ((Maybe Deref, [Content]) -> Bool)
-> [(Maybe Deref, [Content])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Deref -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Deref -> Bool)
-> ((Maybe Deref, [Content]) -> Maybe Deref)
-> (Maybe Deref, [Content])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Deref, [Content]) -> Maybe Deref
forall a b. (a, b) -> a
fst) [(Maybe Deref, [Content])]
cs = Maybe Deref
forall a. Maybe a
Nothing
    | Bool
otherwise = Deref -> Maybe Deref
forall a. a -> Maybe a
Just (Deref -> Maybe Deref) -> Deref -> Maybe Deref
forall a b. (a -> b) -> a -> b
$ Deref -> Deref -> Deref
DerefBranch (Ident -> Deref
DerefIdent Ident
specialOrIdent) (Deref -> Deref) -> Deref -> Deref
forall a b. (a -> b) -> a -> b
$ [Deref] -> Deref
DerefList ([Deref] -> Deref) -> [Deref] -> Deref
forall a b. (a -> b) -> a -> b
$ ((Maybe Deref, [Content]) -> Maybe Deref)
-> [(Maybe Deref, [Content])] -> [Deref]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Deref, [Content]) -> Maybe Deref
forall a b. (a, b) -> a
fst [(Maybe Deref, [Content])]
cs

-- | This funny hack is to allow us to refer to the 'or' function without
-- requiring the user to have it in scope. See how this function is used in
-- Text.Hamlet.
specialOrIdent :: Ident
specialOrIdent :: Ident
specialOrIdent = String -> Ident
Ident String
"__or__hamlet__special"