Haskell¶

dependencies:
- base >= 4.7 && < 5
- bytestring
- utf8-string

fromIntegral.ord $ 'd'

import qualified Codec.Binary.UTF8.String as US
US.encode 'd'

lf :: W.Word8
lf = fromIntegral.ord $ '\n'

space :: W.Word8
space = fromIntegral.ord $ ' '

ghcup install ghc <version>
ghcup set ghc <version>

ghcup nuke

ghcup upgrade

{-# LANGUAGE OverloadedLists#-}
import qualified Data.Vector as V
main = do
  let a = [1..10]
  print $ a = V.fromList [1..10]

Prelude> :t id
id :: a -> a
Prelude> :t head
head :: [a] -> a

Prelude> :t show
show :: Show a => a -> String

Prelude> data Employee = NewEmployee Integer Bool String

Prelude> data Employee = NewEmployee Integer Bool String deriving (Show)

Prelude> :t NewEmployee
NewEmployee :: Integer -> Bool -> String -> Employee
Prelude> employee = NewEmployee 39 False "Subhash Khot"
Prelude> employee
NewEmployee 39 False "Subhash Khot"

Prelude> NewEmployee age isManager name = employee
Prelude> age
39
Prelude> isManager
False
Prelude> name
"Subhash Khot"

data 型コンストラクタ名 =
  データコンストラクタ名 1 フィールドの型 1-1 フィールドの型 1-2 ...
  | データコンストラクタ名 2 フィールドの型 2-1 フィールドの型 2-2 ...

data LazyAndStrict = LazyAndStrict
                     { lsLazy
                     :: Int
                     , lsStrict :: !Int
                     }

data 型コンストラクタ名 = データコンストラクタ名 { フィールド名 1 :: 型名 1, フィールド名 2 :: 型名 2 }

data Employee = NewEmployee { employeeAge :: Integer
                            , employeeIsManager :: Bool
                            , employeeName :: String
                            } deriving (Show)

Prelude> -- あらかじめ代数的データ型`Employee`を定義しておく
Prelude> :t employeeAge
employeeAge :: Employee -> Integer

Prelude> data A = B
Prelude> data C d = E { f :: d, g :: A }
Prelude> data H = I A (C A)

newtype 型コンストラクタ名 = データコンストラクタ名 型

Prelude> :t (+)
(+) :: Num a => a -> a -> a

Prelude> sample x = x
Prelude> :t sample
sample :: t -> t
Prelude> -- 2 引数の場合は t, t1
Prelude> sample2Params f x = f x
Prelude> :t sample2Params
sample2Params :: (t1 -> t) -> t1 -> t

assoc :: (Eq a, Eq b) =>a ->[(a, b)] ->Maybe b
assoc _ [] = Nothing
assoc ekimei0 (x:xs) =
  if fst x == ekimei0 then Just (snd x)
  else assoc ekimei0 xs

main = do
  -- 実行するとエラーになる：今の腕では解消できない
  print $ assoc "後楽園" [] == Nothing
  print $ assoc "後楽園" [("新大塚", 1.2), ("後楽園", 1.8)] == Just (1.8)
  print $ assoc "池袋" [("新大塚", 1.2), ("後楽園", 1.8)] == Nothing

ex18_3_1.hs:11:11: error:
    • Ambiguous type variable ‘b0’ arising from a use of ‘==’
      prevents the constraint ‘(Eq b0)’ from being solved.
      Probable fix: use a type annotation to specify what ‘b0’ should be.
      These potential instances exist:
        instance Eq Ordering -- Defined in ‘GHC.Classes’
        instance Eq Integer
          -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’
        instance Eq a =>Eq (Maybe a) -- Defined in ‘GHC.Base’
        ...plus 22 others
        ...plus 9 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the second argument of ‘($)’, namely
        ‘assoc "\24460\27005\22290" [] == Nothing’
      In a stmt of a 'do' block:
        print $ assoc "\24460\27005\22290" [] == Nothing
      In the expression:
        do { print $ assoc "\24460\27005\22290" [] == Nothing;
             print
             $ assoc
                 "\24460\27005\22290"
                 [("\26032\22823\22618", 1.2), ("\24460\27005\22290", 1.8)]
               == Just (1.8);
             print
             $ assoc
                 "\27744\34955"
                 [("\26032\22823\22618", 1.2), ("\24460\27005\22290", 1.8)]
               == Nothing }
</code></pre></div>

$ ghci --version
The Glorious Glasgow Haskell Compilation System, version 8.0.1

-- Int を Nat にしたい: Nat 自体は例えば Data.Nat にはある. 適当にインポートしたりする必要あり?
minfree :: [Int] -> Int
--minfree xs = head $ [0..] Data.List.\\ xs
minfree xs = head $ [0..] Main.\\ xs

-- Data.List.\\ にある関数: 本の記述では notElem が TeX でいう $\notin$ の記号で書かれていた.
(\\) :: Eq a => [a] -> [a] -> [a]
us \\ vs = filter (not . flip elem vs) us

main = do
  let a = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
--  print $ Data.List.sort a
  print $ minfree a

: 15

import Data.Array

minfree' = search . checklist

search :: Array Int Bool -> Int
search = length . takeWhile id . elems

checklist :: [Int] -> Array Int Bool
checklist xs = accumArray (||) False (0, n) $ zip (filter (<= n) xs) (repeat True)
    where n = length xs

main = do
  print $ minfree' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]

:
: 15

main = do
  let xs = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
  let n = length xs
  let a = zip (filter (<= n) xs) (repeat True)
  -- print $ repeat True
  print $ filter (<= n) xs
  print a

: [8,9,0,12,11,1,10,13,7,4,14,5,17,3,19,2,6]
: [(8,True),(9,True),(0,True),(12,True),(11,True),(1,True),(10,True),(13,True),(7,True),(4,True),(14,True),(5,True),(17,True),(3,True),(19,True),(2,True),(6,True)]

import Data.Array

main = do
  -- 配列の添字は [1..3]
  -- 配列の各要素は第 2 引数 0 で初期化される
  let a = [(1, 2), (3, 4), (1, 5)]
  print $ accumArray (+) 0 (1,3) a

: array (1,3) [(1,7),(2,0),(3,4)]

minfree' = search . checklist

search :: Array Int Bool -> Int
search = length . takeWhile id . elems

checklist :: [Int] -> Array Int Bool
checklist xs = accumArray (||) False (0, n) $ zip (filter (<= n) xs) (repeat True)
    where n = length xs

import Data.Array

main = do
  let a = listArray (0,3) [1,2,3,4]
  print $ a
  print $ elems a

: array (0,3) [(0,1),(1,2),(2,3),(3,4)]
: [1,2,3,4]

import Data.List
minfreeDivideAndConquer b xs =
  if null ([0..b-1] Data.List.\\ us)
  then head ([b..] Data.List.\\ vs)
  else head ([0..] Data.List.\\ us)
  where (us, vs) = partition (< b) xs

main = do
  let a = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
  print $ Data.List.sort a
  print $ minfreeDivideAndConquer 4 a

: [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,17,19,21,23,41]
: 15

main = do
  print $ null []
  print $ null [1]

:
: True
: False

import Data.List
main = do
  print $ Data.List.partition (< 2) [1,2,3,4]

: ([1],[2,3,4])

minfrom :: Int -> [Int] -> Int
minfrom a xs = head ([a..] \\ xs)

import Data.List
b = 5
minfreeDivideAndConquer' xs = minfrom 0 xs
minfrom a xs | null xs            = a
             | length us == b - a = minfrom b vs
             | otherwise          = minfrom a us
  where (us, vs) = partition (< b) xs

main = do
  print $ minfreeDivideAndConquer' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]

import Data.List
minfreeDivideAndConquer'' xs = minfrom 0 (length xs, xs)
minfrom a (n, xs) | n == 0     = a
                  | m == b - a = minfrom b (n - m, vs)
                  | otherwise  = minfrom a (m, us)
  where (us, vs) = partition (< b) xs
        b        = a + 1 + n `div` 2
        m        = length us

main = do
  print $ minfreeDivideAndConquer'' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]

:
: 15

msc :: Ord a => [a] -> Int
msc xs = maximum [scount z zs | z : zs <- tails xs]
scount x xs = length (filter (x <) xs)

tails [ ] = [ ]
tails (x : xs) = (x : xs) : tails xs

main = do
  print $ msc [1,2,3,4]

: 3

tails [] = []
tails (x : xs) = (x : xs) : tails xs

main = do
  print $ tails [1,2,3,4]

: [[1,2,3,4],[2,3,4],[3,4],[4]]

import Data.List
main = do
  print $ Data.List.tails [1,2,3,4]

: [[1,2,3,4],[2,3,4],[3,4],[4],[]]

scount x xs = length (filter (x <) xs)

tails [ ] = [ ]
tails (x : xs) = (x : xs) : tails xs

table xs = [(z, scount z zs) | z : zs <- tails xs]

main = do
  print $ table [1,2,3,4,6,5]

: [(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)]

scount x xs = length (filter (x <) xs)

tails [ ] = [ ]
tails (x : xs) = (x : xs) : tails xs

table xs = [(z, scount z zs) | z : zs <- tails xs]

msc' = maximum . map snd . table

main = do
  print $ table [1,2,3,4,6,5]
  print $ msc' [1,2,3,4,6,5]

: [(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)]
: 5

main = do
  let l = [(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)]
  print $ map fst l
  print $ map snd l

: [1,2,3,4,6,5]
: [5,4,3,2,0,0]

msc' :: Ord a => [a] -> Int
msc' = maximum . map snd . table

table [x] = [(x, 0)]
table xs = join (m-n) (table ys) (table zs)
  where m        = length xs
        n        = m `div` 2
        (ys, zs) = splitAt n xs

join _ tys [] = tys
join _ [] tzs = tzs
join n tys@((y, c):tys') tzs@((z, d):tzs')
    | y < z     = (y, c+n) : join n     tys' tzs
    | otherwise = (z, d)   : join (n-1) tys  tzs'

main = do
  let l = [1,2,3,4,6,5]
  print $ table l
  print $ msc' l

: [(1,5),(2,4),(3,3),(4,2),(5,0),(6,0)]
: 5

testFunc lst@(x:xs) = [(x, 0)] ++ [(a, 1) | a <- xs]
main = do
  print $ testFunc [1,2,3]

: [(1,0),(2,1),(3,1)]

main = do
  let list = 1 : [2, 3]
  print list

: [1,2,3]

main = do
  let xs = [1,3,2]
  let m = length xs
  let n = m `div` 2
  let ys = fst $ splitAt n xs
  let zs = snd $ splitAt n xs

  print m
  print n
  print (m - n)
  print ys
  print zs

: 3
: 1
: 2
: [1]
: [3,2]

infixr 4 ⩕
(⩕) ∷ Ord a ⇒ [a] → [a] → [a]
[] ⩕ ys = ys
xs ⩕ [] = xs
xxs@(x:xs) ⩕ yys@(y:ys)
  | x > y = y : (xxs ⩕ ys)
  | otherwise = x : (xs ⩕ yys)

saddleBackSample (x, y) = x^2 + 2 * y^2
main = do
  print $ saddleBackSample (1, 2)

saddleBackSample (x, y) = x^2 + 2 * y^2
invert f z = [(x,y) | x <- [0..z], y <- [0..z], f (x,y) == z]

main = do
  print $ invert saddleBackSample 18

saddleBackSample (x, y) = x^2 + 2 * y^2
invert1 f z = [(x,y) | x <- [0..z], y <- [0..z-x], f (x,y) == z]

main = do
  print $ invert1 saddleBackSample 18

saddleBackSample (x, y) = x^2 + 2 * y^2
find (u, v) f z = [(x, y) | x <- [u..z], y <- [v, v-1..0], f (x,y) == z]
invert2 f z = find (0, z) f z

main = do
  print $ invert2 saddleBackSample 18

saddleBackSample (x, y) = x^2 + 2 * y^2
invert3 f z = find (0, z) f z
find (u, v) f z
  | u > z || v < 0 = []
  | z' < z         = find (u+1, v) f z
  | z' == z        = (u, v) : find (u+1, v-1) f z
  | z' > z         = find (u, v-1) f z
  where z' = f (u, v)

main = do
  print $ invert3 saddleBackSample 18

saddleBackSample (x, y) = x^2 + 2 * y^2
invert4 f z = find (0, m) f z n
  where m = bsearch (\y -> f (0, y)) (-1, z+1) z
        n = bsearch (\x -> f (x, 0)) (-1, z+1) z

find (u,v) f z n
  | u > n || v < 0 = []
  | z' < z = find (u+1, v) f z n
  | z' > z = find (u, v-1) f z n
  | otherwise = (u,v) : find (u+1, v-1) f z n
  where z' = f (u,v)

bsearch g (a,b) z
  | a+1 == b  = a
  | g m <= z  = bsearch g (m,b) z
  | otherwise = bsearch g (a,m) z
  where m = (a + b) `div` 2

main = do
  print $ invert4 saddleBackSample 18

m = maximum $ filter (\y -> f (0, y) <= z) [0..z]
n = maximum $ filter (\z -> f (0, z) <= z) [0..z]

add m n = m + n
(.+.) a b = add a b

8 `add` 6 -- 14
add 8 6 -- 14
8 .+. 6 -- 14
(.+.) 8 6 -- 14

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.Text
import Control.Applicative

sectionTopParser =
     (string "* "       >> return "# ")
 <|> (string "** "      >> return "## ")
 <|> (string "*** "     >> return "### ")
 <|> (string "**** "    >> return "#### ")
 <|> (string "***** "   >> return "##### ")
 <|> (string "****** "  >> return "###### ")
 <|> (string "******* " >> return "####### ")

main :: IO ()
main = do
  print $ parseOnly sectionTopParser "* test        **a** $f * g$"
  print $ parseOnly sectionTopParser "** test       **a** $f * g$"
  print $ parseOnly sectionTopParser "*** test      **a** $f * g$"
  print $ parseOnly sectionTopParser "**** test     **a** $f * g$"
  print $ parseOnly sectionTopParser "***** test    **a** $f * g$"
  print $ parseOnly sectionTopParser "****** test   **a** $f * g$"
  print $ parseOnly sectionTopParser "******* test  **a** $f * g$"
  print $ parseOnly sectionTopParser "******** test **a** $f * g$"

: <interactive>:124:11-19: error:
:     Variable not in scope: parseOnly :: t0 -> [Char] -> ()
:
: <interactive>:124:21-36: error:
:     Variable not in scope: sectionTopParser

{-# LANGUAGE OverloadedStrings #-}
import Data.Attoparsec.ByteString.Char8
import Data.Word

data IP = IP Word8 Word8 Word8 Word8 deriving Show

parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

main :: IO ()
main = print $ parseOnly parseIP "131.45.68.123"

: Right (IP 131 45 68 123)

{-# LANGUAGE OverloadedStrings #-}
import Data.Time
import Data.Attoparsec.ByteString.Char8

timeParser :: Parser LocalTime
timeParser = do
  y  <- count 4 digit
  char '-'
  mm <- count 2 digit
  char '-'
  d  <- count 2 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

main :: IO ()
main = print $ parseOnly timeParser "2013-06-30 14:33:29"

: Right 2013-06-30 14:33:29

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.ByteString.Char8
import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

main :: IO ()
main = do
  print $ parseOnly productParser "mouse"
  print $ parseOnly productParser "mouze"
  print $ parseOnly productParser "monitor"
  print $ parseOnly productParser "keyboard"

: Right Mouse
: Left "string"
: Right Monitor
: Right Keyboard

{-# LANGUAGE OverloadedStrings #-}
import Data.Word
import Data.Time
import Data.Attoparsec.ByteString.Char8
import Control.Applicative

{- TYPES -}
-- | Type for IP's.
data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data LogEntry =
  LogEntry { entryTime :: LocalTime
           , entryIP   :: IP
           , entryProduct   :: Product
             } deriving Show

-- | Parser of values of type 'IP'.
parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'.
timeParser :: Parser LocalTime
timeParser = do
  y  <- count 4 digit
  char '-'
  mm <- count 2 digit
  char '-'
  d  <- count 2 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

-- | Parser of values of type 'Product'.
productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

-- show
-- | Parser of log entries.
logEntryParser :: Parser LogEntry
logEntryParser = do
  -- First, we read the time.
  t <- timeParser
  -- Followed by a space.
  char ' '
  -- And then the IP of the client.
  ip <- parseIP
  -- Followed by another space.
  char ' '
  -- Finally, we read the type of product.
  p <- productParser
  -- And we return the result as a value of type 'LogEntry'.
  return $ LogEntry t ip p

{- TEST -}
main :: IO ()
main =
  print $ parseOnly logEntryParser "2013-06-29 11:16:23 124.67.34.60 keyboard"

: Right (LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard})

{-# LANGUAGE OverloadedStrings #-}
import Data.Word
import Data.Time
import Data.Attoparsec.ByteString.Char8
import Control.Applicative
import qualified Data.ByteString as B

-- Settings
-- | File where the log is stored.
logFile :: FilePath
logFile = "babel_haskell_selling.log"

-- Types
data IP = IP Word8 Word8 Word8 Word8 deriving Show
data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

-- | Type for log entries.
--   Add, remove of modify fields to fit your own log file.
data LogEntry =
  LogEntry { entryTime :: LocalTime
           , entryIP   :: IP
           , entryProduct :: Product
             } deriving Show

type Log = [LogEntry]

-- Parsing
-- | Parser of values of type 'IP'.
parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'.
timeParser :: Parser LocalTime
timeParser = do
  y  <- count 4 digit
  char '-'
  mm <- count 2 digit
  char '-'
  d  <- count 2 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

-- | Parser of values of type 'Product'.
productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

-- | Parser of log entries.
logEntryParser :: Parser LogEntry
logEntryParser = do
  -- First, we read the time.
  t <- timeParser
  -- Followed by a space.
  char ' '
  -- And then the IP of the client.
  ip <- parseIP
  -- Followed by another space.
  char ' '
  -- Finally, we read the type of product.
  p <- productParser
  -- And we return the result as a value of type 'LogEntry'.
  return $ LogEntry t ip p

logParser :: Parser Log
logParser = many $ logEntryParser <* endOfLine

-- Main
main :: IO ()
main = do
  a <- B.readFile logFile
  print $ parseOnly logParser a

: Right [LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard},LogEntry {entryTime = 2013-06-29 11:32:12, entryIP = IP 212 141 23 67, entryProduct = Mouse},LogEntry {entryTime = 2013-06-29 11:33:08, entryIP = IP 212 141 23 67, entryProduct = Monitor},LogEntry {entryTime = 2013-06-29 12:12:34, entryIP = IP 125 80 32 31, entryProduct = Speakers},LogEntry {entryTime = 2013-06-29 12:51:50, entryIP = IP 101 40 50 62, entryProduct = Keyboard},LogEntry {entryTime = 2013-06-29 13:10:45, entryIP = IP 103 29 60 13, entryProduct = Mouse}]

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.ByteString.Char8
import Control.Applicative

data Source = Internet | Friend | NoAnswer deriving Show

sourceParser :: Parser Source
sourceParser =
      (string "internet" >> return Internet)
  <|> (string "friend" >> return Friend)
  <|> (string "noanswer" >> return NoAnswer)

main :: IO ()
main = print $ parseOnly sourceParser "internet"

: Right Internet

{-# LANGUAGE OverloadedStrings #-}
import Data.Word
import Data.Time
import Data.Attoparsec.ByteString.Char8
import Control.Applicative
-- We import ByteString qualified because the function
-- 'Data.ByteString.readFile' would clash with
-- 'Prelude.readFile'.
import qualified Data.ByteString as B

-----------------------
------ SETTINGS -------
-----------------------

-- | File where the log is stored.
logFile :: FilePath
logFile = "babel_haskell_selling.log"

-----------------------
-------- TYPES --------
-----------------------

-- | Type for IP's.
data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data Source = Internet | Friend | NoAnswer deriving Show

-- show
data LogEntry =
  LogEntry { entryTime :: LocalTime
           , entryIP   :: IP
           , entryProduct   :: Product
             -- Addition of the 'Source' field
           , source    :: Source
             } deriving Show
-- /show

type Log = [LogEntry]

-----------------------
------- PARSING -------
-----------------------

-- | Parser of values of type 'IP'.
parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'.
timeParser :: Parser LocalTime
timeParser = do
  y  <- count 4 digit
  char '-'
  mm <- count 2 digit
  char '-'
  d  <- count 2 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

-- | Parser of values of type 'Product'.
productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

sourceParser :: Parser Source
sourceParser =
      (string "internet" >> return Internet)
  <|> (string "friend" >> return Friend)
  <|> (string "noanswer" >> return NoAnswer)

-- show
-- | Parser of log entries.
logEntryParser :: Parser LogEntry
logEntryParser = do
  t <- timeParser
  char ' '
  ip <- parseIP
  char ' '
  p <- productParser
  -- Addition of the 'Source' field
  char ' '
  s <- sourceParser
  --
  return $ LogEntry t ip p s
-- /show

logParser :: Parser Log
logParser = many $ logEntryParser <* endOfLine

----------------------
-------- MAIN --------
----------------------

main :: IO ()
main = B.readFile logFile >>= print . parseOnly logParser

: Right [LogEntry {entryTime = 2013-06-29 16:40:15, entryIP = IP 154 41 32 99, entryProduct = Monitor, source = Internet},LogEntry {entryTime = 2013-06-29 16:51:12, entryIP = IP 103 29 60 13, entryProduct = Keyboard, source = Internet},LogEntry {entryTime = 2013-06-29 17:13:21, entryIP = IP 121 95 68 21, entryProduct = Speakers, source = Friend},LogEntry {entryTime = 2013-06-29 18:20:10, entryIP = IP 190 80 70 60, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 18:51:23, entryIP = IP 102 42 52 64, entryProduct = Speakers, source = Friend}]

{-# LANGUAGE OverloadedStrings #-}
import Data.Word
import Data.Time
import Data.Attoparsec.ByteString.Char8
import Control.Applicative
-- We import ByteString qualified because the function
-- 'Data.ByteString.readFile' would clash with
-- 'Prelude.readFile'.
import qualified Data.ByteString as B

-----------------------
------ SETTINGS -------
-----------------------

-- | File where the log is stored.
logFile :: FilePath
logFile = "babel_haskell_selling7.log"

-----------------------
-------- TYPES --------
-----------------------

-- | Type for IP's.
data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data Source = Internet | Friend | NoAnswer deriving Show

data LogEntry =
  LogEntry { entryTime :: LocalTime
           , entryIP   :: IP
           , entryProduct   :: Product
           , source    :: Source
             } deriving Show

type Log = [LogEntry]

-----------------------
------- PARSING -------
-----------------------

-- | Parser of values of type 'IP'.
parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'.
timeParser :: Parser LocalTime
timeParser = do
  y  <- count 4 digit
  char '-'
  mm <- count 2 digit
  char '-'
  d  <- count 2 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

-- | Parser of values of type 'Product'.
productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

sourceParser :: Parser Source
sourceParser =
      (string "internet" >> return Internet)
  <|> (string "friend" >> return Friend)
  <|> (string "noanswer" >> return NoAnswer)

-- show
-- | Parser of log entries.
logEntryParser :: Parser LogEntry
logEntryParser = do
  t <- timeParser
  char ' '
  ip <- parseIP
  char ' '
  p <- productParser
  -- Look for the field 'Source' and return
  -- a default value ('NoAnswer') when missing.
  -- The arguments of 'option' are default value
  -- followed by the parser to try.
  s <- option NoAnswer $ char ' ' >> sourceParser
  --
  return $ LogEntry t ip p s
-- /show

logParser :: Parser Log
logParser = many $ logEntryParser <* endOfLine

----------------------
-------- MAIN --------
----------------------

main :: IO ()
main = do
  a <- B.readFile logFile
  print $ parseOnly logParser a

: Right [LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard, source = NoAnswer},LogEntry {entryTime = 2013-06-29 11:32:12, entryIP = IP 212 141 23 67, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 11:33:08, entryIP = IP 212 141 23 67, entryProduct = Monitor, source = NoAnswer},LogEntry {entryTime = 2013-06-29 12:12:34, entryIP = IP 125 80 32 31, entryProduct = Speakers, source = NoAnswer},LogEntry {entryTime = 2013-06-29 12:51:50, entryIP = IP 101 40 50 62, entryProduct = Keyboard, source = NoAnswer},LogEntry {entryTime = 2013-06-29 13:10:45, entryIP = IP 103 29 60 13, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 16:40:15, entryIP = IP 154 41 32 99, entryProduct = Monitor, source = Internet},LogEntry {entryTime = 2013-06-29 16:51:12, entryIP = IP 103 29 60 13, entryProduct = Keyboard, source = Internet},LogEntry {entryTime = 2013-06-29 17:13:21, entryIP = IP 121 95 68 21, entryProduct = Speakers, source = Friend},LogEntry {entryTime = 2013-06-29 18:20:10, entryIP = IP 190 80 70 60, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 18:51:23, entryIP = IP 102 42 52 64, entryProduct = Speakers, source = Friend}]

-- | Different kind of products are numbered from 1 to 4, in the given
--   order.
data Product = Mouse | Keyboard | Monitor | Speakers deriving (Enum,Show)

productFromID :: Int -> Product
productFromID n = toEnum (n-1)

productToID :: Product -> Int
productToID p = fromEnum p + 1

main :: IO ()
main = do
  print $ productFromID 1
  print $ productFromID 3
  print $ productToID Keyboard
  print $ productToID $ productFromID 4

: Mouse
: Monitor
: 2
: 4

{-# LANGUAGE OverloadedStrings #-}
import Data.Attoparsec.ByteString.Char8
import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving (Enum,Show)

productFromID :: Int -> Product
productFromID n = toEnum (n-1)

-- show
productParser2 :: Parser Product
productParser2 = productFromID . read . (:[]) <$> digit

main :: IO ()
main = print $ parseOnly productParser2 "4"

: Right Speakers

{-# LANGUAGE OverloadedStrings #-}
import Data.Time
import Data.Attoparsec.ByteString.Char8

timeParser2 :: Parser LocalTime
timeParser2 = do
  d  <- count 2 digit
  char '/'
  mm <- count 2 digit
  char '/'
  y  <- count 4 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

main :: IO ()
main = print $ parseOnly timeParser2 "29/06/2013 15:32:23"

: Right 2013-06-29 15:32:23

{-# LANGUAGE OverloadedStrings #-}

import Data.Word
import Data.Time
import Data.Attoparsec.ByteString.Char8
import Control.Applicative

-----------------------
-------- TYPES --------
-----------------------

-- | Type for IP's.
data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving (Show,Enum)

productFromID :: Int -> Product
productFromID n = toEnum (n-1)

data Source = Internet | Friend | NoAnswer deriving Show

data LogEntry =
  LogEntry { entryTime :: LocalTime
           , entryIP   :: IP
           , entryProduct   :: Product
           , source    :: Source
             } deriving Show

type Log = [LogEntry]

-----------------------
------- PARSING -------
-----------------------

-- | Parser of values of type 'IP'.
parseIP :: Parser IP
parseIP = do
  d1 <- decimal
  char '.'
  d2 <- decimal
  char '.'
  d3 <- decimal
  char '.'
  d4 <- decimal
  return $ IP d1 d2 d3 d4

timeParser2 :: Parser LocalTime
timeParser2 = do
  d  <- count 2 digit
  char '/'
  mm <- count 2 digit
  char '/'
  y  <- count 4 digit
  char ' '
  h  <- count 2 digit
  char ':'
  m  <- count 2 digit
  char ':'
  s  <- count 2 digit
  return $
    LocalTime { localDay = fromGregorian (read y) (read mm) (read d)
              , localTimeOfDay = TimeOfDay (read h) (read m) (read s)
                }

productParser2 :: Parser Product
productParser2 = productFromID . read . (:[]) <$> digit

sourceParser :: Parser Source
sourceParser =
      (string "internet" >> return Internet)
  <|> (string "friend" >> return Friend)
  <|> (string "noanswer" >> return NoAnswer)

-- show
logEntryParser2 :: Parser LogEntry
logEntryParser2 = do
  ip <- parseIP
  char ' '
  t <- timeParser2
  char ' '
  p <- productParser2
  char ' '
  s <- sourceParser
  return $ LogEntry t ip p s

main :: IO ()
main = print $ parseOnly logEntryParser2 "54.41.32.99 29/06/2013 15:32:23 4 internet"

: Right (LogEntry {entryTime = 2013-06-29 15:32:23, entryIP = IP 54 41 32 99, entryProduct = Speakers, source = Internet})

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.Text
import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

productParser :: Parser Product
productParser =
     (string "mouse"    >> return Mouse)
 <|> (string "keyboard" >> return Keyboard)
 <|> (string "monitor"  >> return Monitor)
 <|> (string "speakers" >> return Speakers)

main :: IO ()
main = do
  print $ parseOnly productParser "mouse"
  print $ parseOnly productParser "mouze"
  print $ parseOnly productParser "monitor"
  print $ parseOnly productParser "keyboard"

: Right Mouse
: Left "string"
: Right Monitor
: Right Keyboard

{-# LANGUAGE OverloadedStrings #-}
-- stack install attoparsec

import qualified Data.Text    as T -- 重複を防ぐ
import qualified Data.Text.IO as TIO -- 重複を防ぐ
import Data.Attoparsec.Text hiding (take)
import Control.Applicative

quotedText :: Parser T.Text
quotedText = char '{' *> takeTill (== '}') <* char '}'

labeledName :: Parser T.Text
labeledName = manyTill anyChar "\\label" *> quotedText

texLabelParser =
  manyTill anyChar "\\label"
  *> char '{'
  *> takeTill (== '}')
  <* char '}'

main :: IO ()
main = do
  print $ parse texLabelParser "name:\\label{Yamada Ichiro}" `feed` ""

: Done "" "Yamada Ichiro"

{-# LANGUAGE OverloadedStrings #-}
-- stack install attoparsec

import qualified Data.Text    as T -- 重複を防ぐ
import qualified Data.Text.IO as TIO -- 重複を防ぐ
import Data.Attoparsec.Text hiding (take)
import Control.Applicative

data SimpleDate = SimpleDate
    { year :: Int
    , month :: Int
    , day :: Int
    } deriving (Eq, Ord, Show, Read)

simpleDate :: Parser SimpleDate
simpleDate =
    SimpleDate <$>
        (read <$> (count 4 digit)) <* char '/' <*>
        (read <$> (count 2 digit)) <* char '/' <*>
        (read <$> (count 2 digit))

labeledBirthday :: Parser SimpleDate
labeledBirthday = "birthday:" *> simpleDate

main :: IO ()
main = do
  print $ parse labeledBirthday "birthday:2016/11/01" `feed` ""

: Done "" (SimpleDate {year = 2016, month = 11, day = 1})

{-# LANGUAGE OverloadedStrings #-}
-- stack install attoparsec

import qualified Data.Text    as T -- 重複を防ぐ
import qualified Data.Text.IO as TIO -- 重複を防ぐ
import Data.Attoparsec.Text hiding (take)
import Control.Applicative

data Term = Add Expr deriving Show
data Expr = ExTerm Double Term | ExEnd Double deriving Show

termParser :: Parser Term
termParser = addParser
  where
    addParser :: Parser Term
    addParser = Add <$ char '+' <*> exprParser

exprParser :: Parser Expr
exprParser = ExTerm <$> double <*> termParser <|> ExEnd <$> double

main :: IO ()
main = do
  print $ parse (exprParser <* endOfInput) "1+2+3" `feed` ""

: Done "" (ExTerm 1.0 (Add (ExTerm 2.0 (Add (ExEnd 3.0)))))

{-# LANGUAGE OverloadedStrings #-}
-- stack install attoparsec

import qualified Data.Text as T
import Data.Attoparsec.Text hiding (take)
import Control.Applicative

data YMD = YMD Int Int Int deriving Show
data HMS = HMS Int Int Int deriving Show

ymdParser :: Parser YMD
ymdParser = YMD
  <$> (countRead 4 digit <?> "Year") <* (char '/' <?> "Delim Y/M")
  <*> (countRead 2 digit <?> "Month") <*
  (char '/' <?> "Delim M/D")
  <*> (countRead 2 digit <?> "Day")

hmsParser :: Parser HMS
hmsParser = HMS
  <$> (countRead 2 digit <?> "Hour") <* (char ':' <?> "Delim H:M")
  <*> (countRead 2 digit <?> "Minute") <* (char ':' <?> "Delim M:S")
  <*> (countRead 2 digit <?> "Second")

dateTimeParser :: Parser (YMD, HMS)
dateTimeParser = (,)
  <$> (ymdParser <?> "YMD")
  <*  (char ' ' <?> "space")
  <*> (hmsParser <?> "HMS")

countRead :: Read a => Int -> Parser Char -> Parser a
countRead i = fmap read . count i

main :: IO ()
main = do
  print $ parse (dateTimeParser <* endOfInput) "2018/08/21hoge 12:00:00" `feed` ""
  print $ parse (dateTimeParser <* endOfInput) "2018/08/21 12:00.00" `feed` ""
  print $ parse (dateTimeParser <* endOfInput) "2018/08/21 12:00:00" `feed` ""

: Fail "hoge 12:00:00" ["space","' '"] "Failed reading: satisfy"
: Fail ".00" ["HMS","Delim M:S","':'"] "Failed reading: satisfy"
: Done "" (YMD 2018 8 21,HMS 12 0 0)

{-# OPTIONS_GHC -Wno-unused-top-binds #-}

import Data.List

css = ["hoge","piyo","fuga"]

main = do
  putStrLn $ unlines css
  putStrLn $ unwords css

  putStrLn $ intercalate "?" css

cabal install --lib [library-name]

cabal install --lib vector
cabal install --lib mtl