1 module Language.Symantic.Document.Valid where
3 import Control.Applicative (Applicative(..))
4 import Control.Monad (Monad(..))
5 import Data.Eq (Eq(..))
6 import Data.Foldable (elem)
7 import Data.Function (($), (.), id)
8 import Data.Functor (Functor(..))
10 import Data.Monoid (Monoid(..))
11 import Data.Ord (Ord(..))
12 import Data.Semigroup (Semigroup(..))
13 import Data.String (IsString(..))
14 import Text.Show (Show)
15 import qualified Data.Text as T
16 import qualified Data.Text.Lazy as TL
18 import Language.Symantic.Document.Sym
25 instance IsString repr => IsString (Valid repr) where
26 fromString = Ok . fromString
28 valid :: Valid repr -> Valid repr
31 -- ** Type 'Error_Valid'
33 = Error_Valid_not_horizontal TL.Text
34 | Error_Valid_negative_replicate Int
37 instance Semigroup repr => Semigroup (Valid repr) where
38 Ok x <> Ok y = Ok $ x <> y
41 KO x <> KO y = KO $ x <> y
42 instance (Doc_Text repr, Semigroup repr) => Monoid (Valid repr) where
45 instance Functor Valid where
47 fmap f (Ok a) = Ok $ f a
48 instance Applicative Valid where
50 Ok f <*> Ok a = Ok $ f a
51 KO e <*> KO e' = KO $ e <> e'
54 instance Monad Valid where
58 instance (Doc_Text repr, Semigroup repr) => Doc_Text (Valid repr) where
59 replicate i _ | i < 0 = KO [Error_Valid_negative_replicate i]
60 replicate i d = d >>= Ok . replicate i
62 integer = pure . integer
64 string = pure . string
67 charH '\n'= KO [Error_Valid_not_horizontal $ TL.singleton '\n']
68 charH c = Ok $ charH c
69 stringH t | '\n' `elem` t = KO [Error_Valid_not_horizontal $ fromString t]
70 stringH t = Ok $ stringH t
71 textH t | T.any (== '\n') t = KO [Error_Valid_not_horizontal $ TL.fromStrict t]
72 textH t = Ok $ textH t
73 ltextH t | TL.any (== '\n') t = KO [Error_Valid_not_horizontal t]
74 ltextH t = Ok $ ltextH t
75 instance Doc_Color repr => Doc_Color (Valid repr) where
76 reverse = fmap reverse
82 magenta = fmap magenta
85 blacker = fmap blacker
87 greener = fmap greener
88 yellower = fmap yellower
90 magentaer = fmap magentaer
93 onBlack = fmap onBlack
95 onGreen = fmap onGreen
96 onYellow = fmap onYellow
98 onMagenta = fmap onMagenta
100 onWhite = fmap onWhite
101 onBlacker = fmap onBlacker
102 onRedder = fmap onRedder
103 onGreener = fmap onGreener
104 onYellower = fmap onYellower
105 onBluer = fmap onBluer
106 onMagentaer = fmap onMagentaer
107 onCyaner = fmap onCyaner
108 onWhiter = fmap onWhiter
109 instance Doc_Decoration repr => Doc_Decoration (Valid repr) where
112 underline = fmap underline