import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
-import Data.Foldable (Foldable(..))
+import Data.Foldable (Foldable, foldr, foldr1)
import Data.Function ((.), ($))
import Data.Functor (Functor(..))
import Data.Int (Int)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..), Ordering(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString)
-import Prelude (Integer, toInteger, fromIntegral, Num(..), undefined, Integral, Real, Enum)
-import Text.Show (Show)
+import Prelude (Integer, fromIntegral, Num(..), pred, undefined, Integral, Real, Enum)
+import Text.Show (Show(..))
+import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
instance Lengthable TL.Text where
length = Nat . fromIntegral . TL.length
+-- * Class 'Splitable'
+class Monoid a => Splitable a where
+ null :: a -> Bool
+ tail :: a -> a
+ break :: (Char -> Bool) -> a -> (a, a)
+ lines :: a -> [a]
+ lines = splitOnChar (== '\n')
+ words :: a -> [a]
+ words = splitOnChar (== ' ')
+ splitOnChar :: (Char -> Bool) -> a -> [a]
+ splitOnChar c a =
+ if null a then []
+ else let (l,a') = break c a in
+ l : if null a' then []
+ else let a'' = tail a' in
+ if null a'' then [mempty] else splitOnChar c a''
+instance Splitable String where
+ null = List.null
+ tail = List.tail
+ break = List.break
+instance Splitable Text.Text where
+ null = Text.null
+ tail = Text.tail
+ break = Text.break
+instance Splitable TL.Text where
+ null = TL.null
+ tail = TL.tail
+ break = TL.break
+
-- * Type 'Column'
type Column = Nat
-- * Class 'Textable'
class (IsString d, Semigroup d) => Textable d where
+ empty :: d
charH :: Char -- ^ XXX: MUST NOT be '\n'
-> d
stringH :: String -- ^ XXX: MUST NOT contain '\n'
-> d
ltextH :: TL.Text -- ^ XXX: MUST NOT contain '\n'
-> d
- replicate :: Int -> d -> d
- integer :: Integer -> d
- default replicate :: Textable (ReprOf d) => Trans d => Int -> d -> d
- default integer :: Textable (ReprOf d) => Trans d => Integer -> d
+ default empty :: Textable (ReprOf d) => Trans d => d
default charH :: Textable (ReprOf d) => Trans d => Char -> d
default stringH :: Textable (ReprOf d) => Trans d => String -> d
default textH :: Textable (ReprOf d) => Trans d => Text.Text -> d
default ltextH :: Textable (ReprOf d) => Trans d => TL.Text -> d
- charH = trans . charH
- stringH = trans . stringH
- textH = trans . textH
- ltextH = trans . ltextH
- replicate = trans1 . replicate
- integer = trans . integer
+ empty = trans empty
+ charH = trans . charH
+ stringH = trans . stringH
+ textH = trans . textH
+ ltextH = trans . ltextH
- empty :: d
newline :: d
space :: d
-- | @x '<+>' y = x '<>' 'space' '<>' y@
-- | @x '</>' y = x '<>' 'newline' '<>' y@
(</>) :: d -> d -> d
int :: Int -> d
+ integer :: Integer -> d
char :: Char -> d
string :: String -> d
text :: Text.Text -> d
ltext :: TL.Text -> d
catH :: Foldable f => f d -> d
catV :: Foldable f => f d -> d
+ unwords :: Foldable f => f d -> d
+ unlines :: Foldable f => f d -> d
foldrWith :: Foldable f => (d -> d -> d) -> f d -> d
foldWith :: Foldable f => (d -> d) -> f d -> d
intercalate :: Foldable f => d -> f d -> d
between :: d -> d -> d -> d
+ replicate :: Int -> d -> d
- newline = "\n"
- space = char ' '
- x <+> y = x <> space <> y
- x </> y = x <> newline <> y
- int = integer . toInteger
- char = \case '\n' -> newline; c -> charH c
- string = catV . fmap stringH . lines
- text = catV . fmap textH . Text.lines
- ltext = catV . fmap ltextH . TL.lines
- catH = foldr (<>) empty
- catV = foldrWith (\x y -> x<>newline<>y)
- foldrWith f ds = if null ds then empty else foldr1 f ds
+ newline = "\n"
+ space = char ' '
+ x <+> y = x <> space <> y
+ x </> y = x <> newline <> y
+ int = stringH . show
+ integer = stringH . show
+ char = \case '\n' -> newline; c -> charH c
+ string = catV . fmap stringH . lines
+ text = catV . fmap textH . lines
+ ltext = catV . fmap ltextH . lines
+ catH = foldr (<>) empty
+ catV = foldrWith (\x y -> x<>newline<>y)
+ unwords = foldr (<>) space
+ unlines = foldr (\x y -> x<>newline<>y) empty
+ foldrWith f ds = if Foldable.null ds then empty else foldr1 f ds
foldWith f = foldrWith $ \a acc -> a <> f acc
intercalate sep = foldrWith (\x y -> x<>sep<>y)
between o c d = o<>d<>c
- -- default catH :: Textable (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
- -- default catV :: Textable (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
- -- catH l = trans (catH (fmap unTrans l))
- -- catV l = trans (catV (fmap unTrans l))
+ replicate cnt t | cnt <= 0 = empty
+ | otherwise = t <> replicate (pred cnt) t
--- * Class 'Alignable'
-class Textable d => Alignable d where
+-- * Class 'Indentable'
+class Textable d => Indentable d where
-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
align :: d -> d
- -- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
- hang :: Indent -> d -> d
- hang ind = align . incrIndent ind
-- | @('incrIndent' ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
incrIndent :: Indent -> d -> d
-- | @('withIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.
column :: (Column -> d) -> d
-- | @('indent' f)@ write @f@ applied to the current 'Indent'.
indent :: (Indent -> d) -> d
+
+ -- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
+ hang :: Indent -> d -> d
+ hang ind = align . incrIndent ind
+
-- | @('endToEndWidth' d f)@ write @d@ then
-- @f@ applied to the difference between
-- the end 'Column' and start 'Column' of @d@.
EQ -> empty
GT -> withIndent (c + m) newline
--- * Class 'Wrapable'
-class (Textable d, Alignable d) => Wrapable d where
- -- | @('ifWrap' onWrap onNoWrap)@
+-- * Class 'Breakable'
+class (Textable d, Indentable d) => Breakable d where
+ -- | @('breakable' f)@ write @f@ applied to whether breaks are activated or not.
+ breakable :: (Maybe Column -> d) -> d
+ -- | @('withBreakable' b d)@ whether to active breaks or not within @d@.
+ withBreakable :: Maybe Column -> d -> d
+ -- | @('ifBreak' onWrap onNoWrap)@
-- write @onWrap@ if @onNoWrap@ leads to a 'Column'
- -- greater or equal to the one sets with 'withWrapColumn',
+ -- greater or equal to the one sets with 'withBreakable',
-- otherwise write @onNoWrap@.
- ifWrap :: d -> d -> d
+ ifBreak :: d -> d -> d
-- | @('breakpoint' onNoBreak onBreak d)@
-- write @onNoBreak@ then @d@ if they fit,
-- @onBreak@ otherwise.
breakpoint :: d -> d -> d -> d
+
-- | @('breakableEmpty' d)@ write @d@ if it fits, 'newline' then @d@ otherwise.
breakableEmpty :: d -> d
breakableEmpty = breakpoint empty newline
+
-- | @x '><' y = x '<>' 'breakableEmpty' y@
(><) :: d -> d -> d
x >< y = x <> breakableEmpty y
+
-- | @('breakableSpace' d)@ write 'space' then @d@ it they fit,
-- 'newline' then @d@ otherwise.
breakableSpace :: d -> d
breakableSpace = breakpoint space newline
+
-- | @x '>+<' y = x '<>' 'breakableSpace' y@
(>+<) :: d -> d -> d
x >+< y = x <> breakableSpace y
+
-- | @'breakableSpaces' ds@ intercalate a 'breakableSpace'
-- between items of @ds@.
breakableSpaces :: Foldable f => f d -> d
breakableSpaces = foldWith breakableSpace
- -- | @'withWrapColumn' col d@ set the 'Column' triggering wrapping to @col@ within @d@.
- withWrapColumn :: Column -> d -> d
+
-- | @('intercalateHorV' sep ds)@
-- write @ds@ with @sep@ intercalated if the whole fits,
-- otherwise write 'align' of @ds@ with 'newline' and @sep@ intercalated.
intercalateHorV :: Foldable f => d -> f d -> d
intercalateHorV sep xs =
- ifWrap
+ ifBreak
(align $ foldWith ((newline <> sep) <>) xs)
(foldWith (sep <>) xs)
:: (ReprOf tr -> ReprOf tr -> ReprOf tr -> ReprOf tr)
-> (tr -> tr -> tr -> tr)
trans3 f t1 t2 t3 = trans (f (unTrans t1) (unTrans t2) (unTrans t3))
-
--- | Break a 'String' into lines while preserving all empty lines.
-lines :: String -> [String]
-lines cs =
- case List.break (== '\n') cs of
- (chunk, _:rest) -> chunk : lines rest
- (chunk, []) -> [chunk]
sourcephile / git / haskell / symantic.git / blobdiff