Last active
January 5, 2022 10:50
-
-
Save mkohlhaas/a936771698944e6242306ec73437f75b to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Ch07b where | |
import Prelude (Unit, discard, show, ($), (<>), (==), (#)) | |
import Data.Eq (class Eq) | |
import Data.Show (class Show) | |
import Data.Generic.Rep (class Generic) | |
import Data.Newtype (class Newtype) | |
import Data.Maybe (Maybe(..)) | |
import Data.Show.Generic (genericShow) | |
import Data.Int (fromString) | |
import Data.String.Common (split) | |
import Data.String.Pattern (Pattern(..)) | |
import Data.Boolean (otherwise) | |
import Effect (Effect) | |
import Effect.Console (log) | |
-------------------- Functions ------------------------------------------------------------ | |
fromAge :: String -> Maybe Age | |
fromAge s = case fromString s of | |
Just n -> Just $ Age n | |
Nothing -> Nothing | |
fromOccupation :: String -> Maybe Occupation | |
fromOccupation s | s == "Doctor" = Just Doctor | |
| s == "Dentist" = Just Dentist | |
| s == "Lawyer" = Just Lawyer | |
| s == "Unemployed" = Just Unemployed | |
| otherwise = Nothing | |
-------------------- Data Types ----------------------------------------------------------- | |
newtype CSV = CSV String | |
data Person = Person { name :: FullName , age :: Age , occupation :: Occupation } | |
newtype FullName = FullName String | |
newtype Age = Age Int | |
data Occupation = Doctor | Dentist | Lawyer | Unemployed | |
-------------------- Type Classes --------------------------------------------------------- | |
class ToCSV a where | |
toCSV :: a -> CSV | |
class FromCSV a where | |
fromCSV :: CSV -> Maybe a | |
-------------------- Instances ------------------------------------------------------------ | |
derive instance newtypeCSV :: Newtype CSV _ | |
derive newtype instance showCSV :: Show CSV | |
derive newtype instance eqCSV :: Eq CSV | |
derive instance newtypeFullName :: Newtype FullName _ | |
derive newtype instance eqFullName :: Eq FullName | |
-- derive newtype instance showFullName :: Show FullName -- escaped quotes are part of the output; not usable | |
instance showFullName :: Show FullName where | |
show (FullName name) = name | |
derive instance newtypeAge :: Newtype Age _ | |
derive newtype instance showAge :: Show Age | |
derive newtype instance eqAge :: Eq Age | |
derive instance genericOccupation :: Generic Occupation _ | |
derive instance eqOccupation :: Eq Occupation | |
instance showOccupation :: Show Occupation where | |
show = genericShow | |
instance showPerson :: Show Person where | |
show (Person {name, age, occupation}) = show name <> "," <> show age <> "," <> show occupation | |
derive instance eqPerson :: Eq Person | |
instance toCSVPerson :: ToCSV Person where | |
toCSV p = CSV $ show p | |
instance fromCSVPerson :: FromCSV Person where | |
fromCSV (CSV p) = case split (Pattern ",") p of | |
[name, age, occ] -> case fromAge age of | |
Just a-> case fromOccupation occ of | |
Just o -> Just $ (Person {name: FullName name, age: a, occupation: o}) | |
Nothing -> Nothing | |
Nothing -> Nothing | |
_ -> Nothing | |
-------------------- Tests ---------------------------------------------------------------- | |
test :: Effect Unit | |
test = do | |
log "Uncomment lines step by step. Implement/import/derive missing functions and all the rest ..." | |
log $ show $ toCSV (Person { name: FullName "Sue Smith" , age: Age 23 , occupation: Doctor }) | |
log $ show $ toCSV (Person { name: FullName "Sue Smith" , age: Age 23 , occupation: Doctor }) == CSV "Sue Smith,23,Doctor" | |
let person = Person { name: FullName "Sue Smith" , age: Age 23 , occupation: Doctor } | |
log $ show $ (toCSV person # fromCSV) == Just person |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ name = "my-project" | |
, dependencies = [ "console", "effect", "integers", "maybe", "newtype", "prelude", "psci-support", "strings" ] | |
, packages = ./packages.dhall | |
, sources = [ "src//*.purs", "test//*.purs" ] | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment