{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE UndecidableInstances  #-}
module Distribution.FieldGrammar.FieldDescrs (
    FieldDescrs,
    fieldDescrPretty,
    fieldDescrParse,
    fieldDescrsToList,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Data.List                   (dropWhileEnd)
import Distribution.Compat.Lens    (aview, cloneLens)
import Distribution.Compat.Newtype
import Distribution.FieldGrammar
import Distribution.Pretty         (Pretty (..), showFreeText)

import qualified Data.Map                        as Map
import qualified Distribution.Compat.CharParsing as C
import qualified Distribution.Fields.Field       as P
import qualified Distribution.Parsec             as P
import qualified Text.PrettyPrint                as Disp

-- strict pair
data SP s = SP
    { forall s. SP s -> s -> Doc
pPretty :: !(s -> Disp.Doc)
    , forall s. SP s -> forall (m :: * -> *). CabalParsing m => s -> m s
pParse  :: !(forall m. P.CabalParsing m => s -> m s)
    }

-- | A collection of field parsers and pretty-printers.
newtype FieldDescrs s a = F { forall s a. FieldDescrs s a -> Map FieldName (SP s)
runF :: Map P.FieldName (SP s) }
  deriving ((forall a b. (a -> b) -> FieldDescrs s a -> FieldDescrs s b)
-> (forall a b. a -> FieldDescrs s b -> FieldDescrs s a)
-> Functor (FieldDescrs s)
forall a b. a -> FieldDescrs s b -> FieldDescrs s a
forall a b. (a -> b) -> FieldDescrs s a -> FieldDescrs s b
forall s a b. a -> FieldDescrs s b -> FieldDescrs s a
forall s a b. (a -> b) -> FieldDescrs s a -> FieldDescrs s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FieldDescrs s b -> FieldDescrs s a
$c<$ :: forall s a b. a -> FieldDescrs s b -> FieldDescrs s a
fmap :: forall a b. (a -> b) -> FieldDescrs s a -> FieldDescrs s b
$cfmap :: forall s a b. (a -> b) -> FieldDescrs s a -> FieldDescrs s b
Functor)

instance Applicative (FieldDescrs s) where
    pure :: forall a. a -> FieldDescrs s a
pure a
_  = Map FieldName (SP s) -> FieldDescrs s a
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F Map FieldName (SP s)
forall a. Monoid a => a
mempty
    FieldDescrs s (a -> b)
f <*> :: forall a b.
FieldDescrs s (a -> b) -> FieldDescrs s a -> FieldDescrs s b
<*> FieldDescrs s a
x = Map FieldName (SP s) -> FieldDescrs s b
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F (Map FieldName (SP s)
-> Map FieldName (SP s) -> Map FieldName (SP s)
forall a. Monoid a => a -> a -> a
mappend (FieldDescrs s (a -> b) -> Map FieldName (SP s)
forall s a. FieldDescrs s a -> Map FieldName (SP s)
runF FieldDescrs s (a -> b)
f) (FieldDescrs s a -> Map FieldName (SP s)
forall s a. FieldDescrs s a -> Map FieldName (SP s)
runF FieldDescrs s a
x))

singletonF :: P.FieldName -> (s -> Disp.Doc) -> (forall m. P.CabalParsing m => s -> m s) -> FieldDescrs s a
singletonF :: forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g = Map FieldName (SP s) -> FieldDescrs s a
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F (Map FieldName (SP s) -> FieldDescrs s a)
-> Map FieldName (SP s) -> FieldDescrs s a
forall a b. (a -> b) -> a -> b
$ FieldName -> SP s -> Map FieldName (SP s)
forall k a. k -> a -> Map k a
Map.singleton FieldName
fn ((s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s) -> SP s
forall s.
(s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s) -> SP s
SP s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g)

-- | Lookup a field value pretty-printer.
fieldDescrPretty :: FieldDescrs s a -> P.FieldName -> Maybe (s -> Disp.Doc)
fieldDescrPretty :: forall s a. FieldDescrs s a -> FieldName -> Maybe (s -> Doc)
fieldDescrPretty (F Map FieldName (SP s)
m) FieldName
fn = SP s -> s -> Doc
forall s. SP s -> s -> Doc
pPretty (SP s -> s -> Doc) -> Maybe (SP s) -> Maybe (s -> Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> Map FieldName (SP s) -> Maybe (SP s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FieldName
fn Map FieldName (SP s)
m

-- | Lookup a field value parser.
fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> P.FieldName -> Maybe (s -> m s)
fieldDescrParse :: forall (m :: * -> *) s a.
CabalParsing m =>
FieldDescrs s a -> FieldName -> Maybe (s -> m s)
fieldDescrParse (F Map FieldName (SP s)
m) FieldName
fn = (\SP s
f -> SP s -> forall (m :: * -> *). CabalParsing m => s -> m s
forall s. SP s -> forall (m :: * -> *). CabalParsing m => s -> m s
pParse SP s
f) (SP s -> s -> m s) -> Maybe (SP s) -> Maybe (s -> m s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> Map FieldName (SP s) -> Maybe (SP s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FieldName
fn Map FieldName (SP s)
m

fieldDescrsToList
    :: P.CabalParsing m
    => FieldDescrs s a
    -> [(P.FieldName, s -> Disp.Doc, s -> m s)]
fieldDescrsToList :: forall (m :: * -> *) s a.
CabalParsing m =>
FieldDescrs s a -> [(FieldName, s -> Doc, s -> m s)]
fieldDescrsToList = ((FieldName, SP s) -> (FieldName, s -> Doc, s -> m s))
-> [(FieldName, SP s)] -> [(FieldName, s -> Doc, s -> m s)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, SP s) -> (FieldName, s -> Doc, s -> m s)
forall {m :: * -> *} {a} {s}.
CabalParsing m =>
(a, SP s) -> (a, s -> Doc, s -> m s)
mk ([(FieldName, SP s)] -> [(FieldName, s -> Doc, s -> m s)])
-> (FieldDescrs s a -> [(FieldName, SP s)])
-> FieldDescrs s a
-> [(FieldName, s -> Doc, s -> m s)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FieldName (SP s) -> [(FieldName, SP s)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FieldName (SP s) -> [(FieldName, SP s)])
-> (FieldDescrs s a -> Map FieldName (SP s))
-> FieldDescrs s a
-> [(FieldName, SP s)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescrs s a -> Map FieldName (SP s)
forall s a. FieldDescrs s a -> Map FieldName (SP s)
runF where
    mk :: (a, SP s) -> (a, s -> Doc, s -> m s)
mk (a
name, SP s -> Doc
ppr forall (m :: * -> *). CabalParsing m => s -> m s
parse) = (a
name, s -> Doc
ppr, s -> m s
forall (m :: * -> *). CabalParsing m => s -> m s
parse)

-- | /Note:/ default values are printed.
instance FieldGrammar ParsecPretty FieldDescrs where
    blurFieldGrammar :: forall a b d. ALens' a b -> FieldDescrs b d -> FieldDescrs a d
blurFieldGrammar ALens' a b
l (F Map FieldName (SP b)
m) = Map FieldName (SP a) -> FieldDescrs a d
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F ((SP b -> SP a) -> Map FieldName (SP b) -> Map FieldName (SP a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SP b -> SP a
blur Map FieldName (SP b)
m) where
        blur :: SP b -> SP a
blur (SP b -> Doc
f forall (m :: * -> *). CabalParsing m => b -> m b
g) = (a -> Doc)
-> (forall (m :: * -> *). CabalParsing m => a -> m a) -> SP a
forall s.
(s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s) -> SP s
SP (b -> Doc
f (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALens' a b -> a -> b
forall s t a b. ALens s t a b -> s -> a
aview ALens' a b
l) (ALens' a b -> LensLike m a a b b
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' a b
l b -> m b
forall (m :: * -> *). CabalParsing m => b -> m b
g)

    booleanFieldDef :: forall s. FieldName -> ALens' s Bool -> Bool -> FieldDescrs s Bool
booleanFieldDef FieldName
fn ALens' s Bool
l Bool
_def = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s Bool
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = String -> Doc
Disp.text (Bool -> String
forall a. Show a => a -> String
show (ALens' s Bool -> s -> Bool
forall s t a b. ALens s t a b -> s -> a
aview ALens' s Bool
l s
s))
        g :: s -> f s
g s
s = ALens' s Bool -> LensLike f s s Bool Bool
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s Bool
l (f Bool -> Bool -> f Bool
forall a b. a -> b -> a
const f Bool
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
P.parsec) s
s
      -- Note: eta expansion is needed for RankNTypes type-checking to work.

    uniqueFieldAla :: forall b a s.
(ParsecPretty b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> FieldDescrs s a
uniqueFieldAla FieldName
fn a -> b
_pack ALens' s a
l = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = b -> Doc
forall a. Pretty a => a -> Doc
pretty ((a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
pack' a -> b
_pack (ALens' s a -> s -> a
forall s t a b. ALens s t a b -> s -> a
aview ALens' s a
l s
s))
        g :: s -> f s
g s
s = ALens' s a -> LensLike f s s a a
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s a
l (f a -> a -> f a
forall a b. a -> b -> a
const ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
P.parsec)) s
s

    optionalFieldAla :: forall b a s.
(ParsecPretty b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> FieldDescrs s (Maybe a)
optionalFieldAla FieldName
fn a -> b
_pack ALens' s (Maybe a)
l = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s (Maybe a)
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty (b -> Doc
forall a. Pretty a => a -> Doc
pretty (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
pack' a -> b
_pack) (ALens' s (Maybe a) -> s -> Maybe a
forall s t a b. ALens s t a b -> s -> a
aview ALens' s (Maybe a)
l s
s)
        g :: s -> f s
g s
s = ALens' s (Maybe a) -> LensLike f s s (Maybe a) (Maybe a)
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s (Maybe a)
l (f (Maybe a) -> Maybe a -> f (Maybe a)
forall a b. a -> b -> a
const (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (b -> a) -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> Maybe a) -> f b -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
P.parsec)) s
s

    optionalFieldDefAla :: forall b a s.
(ParsecPretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> FieldDescrs s a
optionalFieldDefAla FieldName
fn a -> b
_pack ALens' s a
l a
_def = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = b -> Doc
forall a. Pretty a => a -> Doc
pretty ((a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
pack' a -> b
_pack (ALens' s a -> s -> a
forall s t a b. ALens s t a b -> s -> a
aview ALens' s a
l s
s))
        g :: s -> f s
g s
s = ALens' s a -> LensLike f s s a a
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s a
l (f a -> a -> f a
forall a b. a -> b -> a
const ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
P.parsec)) s
s

    freeTextField :: forall s.
FieldName
-> ALens' s (Maybe String) -> FieldDescrs s (Maybe String)
freeTextField FieldName
fn ALens' s (Maybe String)
l = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s (Maybe String)
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty String -> Doc
showFreeText (ALens' s (Maybe String) -> s -> Maybe String
forall s t a b. ALens s t a b -> s -> a
aview ALens' s (Maybe String)
l s
s)
        g :: s -> f s
g s
s = ALens' s (Maybe String)
-> LensLike f s s (Maybe String) (Maybe String)
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s (Maybe String)
l (f (Maybe String) -> Maybe String -> f (Maybe String)
forall a b. a -> b -> a
const (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> f String -> f (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f String
forall (m :: * -> *). CabalParsing m => m String
parsecFreeText)) s
s

    freeTextFieldDef :: forall s. FieldName -> ALens' s String -> FieldDescrs s String
freeTextFieldDef FieldName
fn ALens' s String
l = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s String
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = String -> Doc
showFreeText (ALens' s String -> s -> String
forall s t a b. ALens s t a b -> s -> a
aview ALens' s String
l s
s)
        g :: s -> f s
g s
s = ALens' s String -> LensLike f s s String String
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s String
l (f String -> String -> f String
forall a b. a -> b -> a
const f String
forall (m :: * -> *). CabalParsing m => m String
parsecFreeText) s
s

    freeTextFieldDefST :: forall s.
FieldName -> ALens' s ShortText -> FieldDescrs s ShortText
freeTextFieldDefST = FieldName -> ALens' s ShortText -> FieldDescrs s ShortText
forall (g :: * -> * -> *) s (c :: * -> Constraint).
(Functor (g s), FieldGrammar c g) =>
FieldName -> ALens' s ShortText -> g s ShortText
defaultFreeTextFieldDefST

    monoidalFieldAla :: forall b a s.
(ParsecPretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> FieldDescrs s a
monoidalFieldAla FieldName
fn a -> b
_pack ALens' s a
l = FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
forall s a.
FieldName
-> (s -> Doc)
-> (forall (m :: * -> *). CabalParsing m => s -> m s)
-> FieldDescrs s a
singletonF FieldName
fn s -> Doc
f forall (m :: * -> *). CabalParsing m => s -> m s
g where
        f :: s -> Doc
f s
s = b -> Doc
forall a. Pretty a => a -> Doc
pretty ((a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
pack' a -> b
_pack (ALens' s a -> s -> a
forall s t a b. ALens s t a b -> s -> a
aview ALens' s a
l s
s))
        g :: s -> f s
g s
s = ALens' s a -> LensLike f s s a a
forall (f :: * -> *) s t a b.
Functor f =>
ALens s t a b -> LensLike f s t a b
cloneLens ALens' s a
l (\a
x -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
x (a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
P.parsec) s
s

    prefixedFields :: forall s.
FieldName
-> ALens' s [(String, String)] -> FieldDescrs s [(String, String)]
prefixedFields FieldName
_fnPfx ALens' s [(String, String)]
_l = Map FieldName (SP s) -> FieldDescrs s [(String, String)]
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F Map FieldName (SP s)
forall a. Monoid a => a
mempty
    knownField :: forall s. FieldName -> FieldDescrs s ()
knownField FieldName
_           = () -> FieldDescrs s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    deprecatedSince :: forall s a.
CabalSpecVersion -> String -> FieldDescrs s a -> FieldDescrs s a
deprecatedSince CabalSpecVersion
_  String
_ FieldDescrs s a
x = FieldDescrs s a
x
    removedIn :: forall s a.
CabalSpecVersion -> String -> FieldDescrs s a -> FieldDescrs s a
removedIn CabalSpecVersion
_ String
_ FieldDescrs s a
x        = FieldDescrs s a
x
    availableSince :: forall a s.
CabalSpecVersion -> a -> FieldDescrs s a -> FieldDescrs s a
availableSince CabalSpecVersion
_ a
_     = FieldDescrs s a -> FieldDescrs s a
forall a. a -> a
id
    hiddenField :: forall s a. FieldDescrs s a -> FieldDescrs s a
hiddenField FieldDescrs s a
_          = Map FieldName (SP s) -> FieldDescrs s a
forall s a. Map FieldName (SP s) -> FieldDescrs s a
F Map FieldName (SP s)
forall a. Monoid a => a
mempty

parsecFreeText :: P.CabalParsing m => m String
parsecFreeText :: forall (m :: * -> *). CabalParsing m => m String
parsecFreeText = String -> String
dropDotLines (String -> String) -> m () -> m (String -> String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall (m :: * -> *). CharParsing m => m ()
C.spaces m (String -> String) -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m Char
forall (m :: * -> *). CharParsing m => m Char
C.anyChar
  where
    -- Example package with dot lines
    -- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal
    dropDotLines :: String -> String
dropDotLines String
"." = String
"."
    dropDotLines String
x = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dotToEmpty ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
x

    dotToEmpty :: String -> String
dotToEmpty String
x | String -> String
trim' String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." = String
""
    dotToEmpty String
x                  = String -> String
trim String
x

    trim' :: String -> String
    trim' :: String -> String
trim' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t" :: String))

    trim :: String -> String
    trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace

class    (P.Parsec a, Pretty a) => ParsecPretty a
instance (P.Parsec a, Pretty a) => ParsecPretty a