1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | Commonly useful functions, a Prelude replacement.
--
-- This is designed to be imported everywhere, unqualified (generally
-- the only unqualified import you should use).
--
-- Alpha can be opinionated and break with other Haskell idioms. For
-- example, we define our own operators which have a pattern to their
-- characters:
--
-- - `|` normal function-level applications
-- - `/` indicates doing something inside a functor
-- - `<` and `>` indicate the direction in which values flow
-- between functions
--
-- It seems unnecessarily different at first but it makes things easier
-- to read quickly.
module Alpha
( -- * Re-export Protolude
module X,
String,
-- * Composing
compose,
(.>),
(<.),
-- * Applying
(<|),
(|>),
-- * Mapping
(/>),
(</),
(<//),
-- * Bool
don't,
-- * Text
chomp,
lchomp,
joinWith,
CanSnakeCase (snake),
wrap,
-- * String
capitalize,
lowercase,
-- * Data Validation
require,
-- * Debugging tools
say,
)
where
import qualified Data.Char as Char
import qualified Data.List as List
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import Protolude as X hiding (($), (&))
-- | Debugging printf
say :: Text -> IO ()
say = putText
-- | Composition
compose :: (a -> b) -> (b -> c) -> (a -> c)
compose f g x = g (f x)
-- | Right-composition operator
infixl 9 .>
(.>) :: (a -> b) -> (b -> c) -> (a -> c)
f .> g = compose f g
-- | Left-composition operator
infixr 9 <.
(<.) :: (b -> c) -> (a -> b) -> (a -> c)
g <. f = compose f g
-- | Alias for map, fmap, <$>
(</) :: Functor f => (a -> b) -> f a -> f b
f </ g = fmap f g
-- | Double fmap. A function on the left goes "into" two functors
-- (i.e. it goes "two levels deep"), applies the function to the inner
-- values, then returns the result wrapped in the two functors.
(<//) :: (Functor f0, Functor f1) => (a -> b) -> f0 (f1 a) -> f0 (f1 b)
(<//) = fmap .> fmap
-- | Normal function application. Do the right side, then pass the
-- return value to the function on the left side.
infixr 0 <|
(<|) :: (a -> b) -> a -> b
f <| g = f g
-- | Reverse function application. Do the left side, then pass the
-- return value to the function on the right side.
infixl 0 |>
(|>) :: a -> (a -> b) -> b
f |> g = g f
-- | Alias for <&>. Can be read as "and then". Basically does into a
-- functor, does some computation, then returns the same kind of
-- functor. Could also be defined as `f >>= return . g`
(/>) :: Functor f => f a -> (a -> b) -> f b
f /> g = fmap g f
-- | Removes newlines from text.
chomp :: Text -> Text
chomp = Text.filter (/= '\n')
-- | Removes newlines from lazy text.
lchomp :: LazyText.Text -> LazyText.Text
lchomp = LazyText.filter (/= '\n')
-- | Join a list of things with a separator.
joinWith :: [a] -> [[a]] -> [a]
joinWith = intercalate
-- | can you just not
don't :: Bool -> Bool
don't = do not
{-# ANN don't ("HLint: ignore Redundant do" :: String) #-}
-- | Class for turning different string types to snakeCase.
class CanSnakeCase str where
snake :: str -> str
instance CanSnakeCase Text where
snake = Text.toLower .> Text.replace " " "-"
capitalize :: String -> String
capitalize [] = []
capitalize str = (Char.toUpper <| List.head str) : (Char.toLower </ List.tail str)
lowercase :: String -> String
lowercase str = [Char.toLower c | c <- str]
require :: Text -> Maybe a -> a
require _ (Just x) = x
require s Nothing = panic <| s <> " not found"
-- | Wrap text at the given limit.
wrap :: Int -> Text -> Text
wrap lim = Text.words .> wrap_ 0 .> Text.unwords
where
wrap_ :: Int -> [Text] -> [Text]
wrap_ _ [] = []
wrap_ pos (w : ws)
| pos == 0 = w : wrap_ (pos + lw) ws
| pos + lw + 1 > lim = wrap_ 0 (Text.cons '\n' w : ws)
| otherwise = w : wrap_ (pos + lw + 1) ws
where
lw = Text.length w
|
